home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 1 / Gold Medal Software Volume 1 (Gold Medal) (1994).iso / prog / util176.arj / UTILITY.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1994-01-26  |  123.0 KB  |  4,444 lines
  1. {$A+,B-,D+,E-,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S-,T-,V-,X-,Y+}
  2. {
  3. Utility 17.6  (c) Copyright 1990, 1994 by Gemini Systems. ALL RIGHTS RESERVED
  4. ╒════════════════════════════════════════════════════════════════════════╕
  5. │                                                                        │
  6. │          This UNIT was written for TURBO PASCAL by:                    │
  7. │                                                                        │
  8. │                      Gemini Systems                                    │
  9. │                      7748 Lake Ridge Drive                             │
  10. │                      Waterford, MI 48327                               │
  11. │                                                                        │
  12. │                  BBS Support (810) 360-6407                            │
  13. │                  Fax support (810) 360-6407                            │
  14. │                                                                        │
  15. │  This code is Shareware.  If you use any part of it for more than 10   │
  16. │  days you must register it.  To register, send $10.00 to the above     │
  17. │  address.                                                              │
  18. │                                                                        │
  19. │  See UTILITY.DOC for complete information on all features.             │
  20. │                                                                        │
  21. │                                                                        │
  22. │  To use in your programs, simply state UTILITY in your uses clause.    │
  23. │                                                                        │
  24. │  example:      PROGRAM prog_name;                                      │
  25. │                  USES utility;       (Programs must be compiled with   │
  26. │                                       the $V- Compiler Directive)      │
  27. │                                                                        │
  28. ╘════════════════════════════════════════════════════════════════════════╛
  29. }
  30.  
  31. {$I UTILITY.DOC }
  32.  
  33. IMPLEMENTATION
  34. CONST
  35.   HEXCHARS  : ARRAY [1..16] OF CHAR =
  36.               ('0','1','2','3','4','5','6','7','8','9',
  37.                'A','B','C','D','E','F');VAR
  38.   ExitSave  : pointer;
  39.   OLDVAL    : STRING;
  40.  
  41. type
  42.   EnvArray = array[0..32767] of Char;
  43.   EnvArrayPtr = ^EnvArray;
  44.   EnvRec =
  45.     record
  46.       EnvSeg : Word;              {Segment of the environment}
  47.       EnvLen : Word;              {Usable length of the environment}
  48.       EnvPtr : Pointer;           {Nil except when allocated on heap}
  49.     end;
  50.  
  51. VAR
  52.   ENV_REC        : ENVREC;
  53.   CURRENT_BORDER : INTEGER;
  54.   BLINK_IS_ON    : BOOLEAN;
  55.  
  56. PROCEDURE FILL_BUFFER;
  57. VAR
  58.   F    : TEXT;
  59.   TEMP : STRING;
  60. BEGIN
  61.   ASSIGN(F,'UTILITY.GO');
  62.   {$I-}
  63.     RESET(F);
  64.   {$I+}
  65.   IF IORESULT = 0 THEN
  66.     BEGIN
  67.       WHILE NOT EOF(F) DO
  68.         BEGIN
  69.           READ(F,TEMP[1]);
  70.           COMMAND_BUFFER := COMMAND_BUFFER + TEMP[1];
  71.         END;
  72.       CLOSE(F);
  73.       SETFATTR(F,ARCHIVE);
  74.       {$I-}
  75.         ERASE(F);
  76.       {$I+}
  77.       IF IORESULT <> 0 THEN;
  78.     END;
  79. END;
  80.  
  81. FUNCTION GETHEX(DECIMAL_VALUE : WORD) : STRING;
  82. VAR
  83.   ADDRESS_DIGIT,
  84.   COUNTER,
  85.   DIVISOR,
  86.   QUOTIENT   : INTEGER;
  87.   TEMPSTRING : STRING;
  88. BEGIN
  89.   GETHEX := '';
  90.   TEMPSTRING := '';
  91.   FOR ADDRESS_DIGIT := 1 TO 4 DO
  92.     BEGIN
  93.       DIVISOR := 1;
  94.       FOR COUNTER := ADDRESS_DIGIT TO 3 DO
  95.         DIVISOR := DIVISOR * 16;
  96.         QUOTIENT := DECIMAL_VALUE DIV DIVISOR;
  97.         DECIMAL_VALUE := DECIMAL_VALUE MOD DIVISOR;
  98.         TEMPSTRING := TEMPSTRING + HEXCHARS[QUOTIENT+1];
  99.       END;
  100.   GETHEX := TEMPSTRING;
  101. END;
  102.  
  103. PROCEDURE SET_CURSOR;
  104. VAR
  105.   TOPLINE,
  106.   BOTLINE       : BYTE;
  107.   BIOSPARAM     : REGISTERS;
  108. BEGIN
  109.   CASE CURS OF
  110.           BLOCK : BEGIN
  111.                     TOPLINE := 0;
  112.                     BOTLINE := 7;
  113.                   END;
  114.      UNDERLINE  : BEGIN
  115.                     TOPLINE := 6;
  116.                     BOTLINE := 7;
  117.                   END;
  118.           NONE  : BEGIN
  119.                     TOPLINE := 32;
  120.                     BOTLINE := 0;
  121.                   END;
  122.           HALF  : BEGIN
  123.                     TOPLINE := 4;
  124.                     BOTLINE := 7;
  125.                   END;
  126.   END;
  127.   WITH BIOSPARAM DO
  128.     BEGIN
  129.       AX := 1 SHL 8 + 0;
  130.       CX := TOPLINE SHL 8 + BOTLINE;
  131.     END;
  132.   INTR($10,BIOSPARAM);
  133.   CUR := CURS;
  134. END;
  135.  
  136. {$F+}
  137. PROCEDURE EXITHANDLER;
  138. VAR
  139.   OFFSET,
  140.   SEGMENT : STRING;
  141. BEGIN
  142.   EXITPROC := EXITSAVE;
  143.   IF RESET_CURSOR THEN
  144.     SET_CURSOR(UNDERLINE);
  145.   IF (EXITCODE <> 0) AND (SHOW_ERROR) THEN
  146.     BEGIN
  147.       OFFSET    := GETHEX(OFS(ERRORADDR^));
  148.       SEGMENT   := GETHEX(SEG(ERRORADDR^));
  149.       WINDOW(1,1,80,25);
  150.       WRITELN;
  151.       ERRORADDR := NIL;
  152.       GOTOXY(1,25);
  153.       WRITELN; WRITELN; WRITELN; WRITELN; WRITELN; WRITELN; WRITELN; WRITELN;
  154.           FW(1,18,$4E,'╔═══════════════════════════════════════════════════════════════════════════╗');
  155.       IF EXITCODE = 255 THEN
  156.         BEGIN
  157.           FW(1,19,$4E,'║    Program Terminated by Operator !                                       ║');
  158.           FW(1,20,$4E,'║      Press <any key> to Continue                                          ║');
  159.           FW(1,21,$4E,'╚═══════════════════════════════════════════════════════════════════════════╝');
  160.           GOTOXY(35,20);
  161.         END
  162.       ELSE
  163.         BEGIN
  164.           FW(1,19,$4E,'║                  Program Terminated by Run-Time Error!                    ║');
  165.           FW(1,20,$4E,'║ Program       -                                                           ║');
  166.           FW(1,21,$4E,'║ Error Code    -                                                           ║');
  167.           FW(1,22,$4E,'║ Error Address -                                                           ║');
  168.           FW(1,23,$4E,'║                       Press <any key> to Continue                         ║');
  169.           FW(1,24,$4E,'╚═══════════════════════════════════════════════════════════════════════════╝');
  170.           TEXTATTR := $4F;
  171.           GOTOXY(19,20);
  172.           WRITE(PARAMSTR(0));
  173.           GOTOXY(19,21);
  174.           WRITE(EXITCODE);
  175.           GOTOXY(19,22);
  176.           WRITE(SEGMENT,':',OFFSET);
  177.           GOTOXY(52,23);
  178.         END;
  179.       CH := READKEY;
  180.       WRITELN;
  181.     END;
  182.   TEXTATTR := TEXTATTR_AT_ENTRY;
  183. END;
  184. {$F-}
  185.  
  186. FUNCTION CGA_INSTALLED : BOOLEAN;
  187. VAR
  188.   MONITOR_INFO   : BYTE;
  189. BEGIN
  190.   MONITOR_INFO := MEM[SEG0040:$0010];
  191.   CGA_INSTALLED := TRUE;
  192.   IF MONITOR_INFO AND 48=48 THEN
  193.     BEGIN
  194.       CGA_INSTALLED := FALSE;
  195.       P := PTR(SEGB000,$0);
  196.     END
  197.   ELSE
  198.     IF MONITOR_INFO AND 32=32 THEN
  199.       BEGIN
  200.         CGA_INSTALLED := TRUE;
  201.         P := PTR(SEGB800,$0);
  202.       END;
  203. END;
  204.  
  205. PROCEDURE SAVE_SCREEN;
  206. BEGIN
  207.   MOVE(P^[1],SCREEN[1],4000);
  208. END;
  209.  
  210. PROCEDURE REBUILD_SCREEN;
  211. BEGIN
  212.   MOVE(SCREEN[1],P^[1],4000);
  213. END;
  214.  
  215. PROCEDURE UP_SOUND;
  216. VAR
  217.   I : INTEGER;
  218. BEGIN
  219.   FOR I := 2000 TO 4000 DO
  220.     SOUND(I);
  221.   NOSOUND;
  222. END;
  223.  
  224. PROCEDURE DOWN_SOUND;
  225. VAR
  226.   I : INTEGER;
  227. BEGIN
  228.   FOR I := 4000 DOWNTO 2000 DO
  229.     SOUND(I);
  230.   NOSOUND;
  231. END;
  232.  
  233. PROCEDURE CAPS_ON;
  234. VAR
  235.   KEYBOARD       : BYTE;
  236. BEGIN
  237.   KEYBOARD := MEM[SEG0040:$0017];
  238.   KEYBOARD:=KEYBOARD OR 64;
  239. END;
  240.  
  241. FUNCTION CAPS_ARE_ON : BOOLEAN;
  242. VAR
  243.   KEYBOARD       : BYTE;
  244. BEGIN
  245.   KEYBOARD := MEM[SEG0040:$0017];
  246.   CAPS_ARE_ON := KEYBOARD AND 64 = 64;
  247. END;
  248.  
  249. PROCEDURE CAPS_OFF;
  250. VAR
  251.   KEYBOARD       : BYTE;
  252. BEGIN
  253.   KEYBOARD := MEM[SEG0040:$0017];
  254.   KEYBOARD:=KEYBOARD AND 191;
  255. END;
  256.  
  257. PROCEDURE NUM_LOCK_ON;
  258. VAR
  259.   KEYBOARD       : BYTE;
  260. BEGIN
  261.   KEYBOARD := MEM[SEG0040:$0017];
  262.   KEYBOARD:=KEYBOARD OR 32;
  263. END;
  264.  
  265. FUNCTION NUM_LOCK_IS_ON : BOOLEAN;
  266. VAR
  267.   KEYBOARD       : BYTE;
  268. BEGIN
  269.   KEYBOARD := MEM[SEG0040:$0017];
  270.   NUM_LOCK_IS_ON := KEYBOARD AND 32 = 32;
  271. END;
  272.  
  273. PROCEDURE NUM_LOCK_OFF;
  274. VAR
  275.   KEYBOARD       : BYTE;
  276. BEGIN
  277.   KEYBOARD := MEM[SEG0040:$0017];
  278.   KEYBOARD:=KEYBOARD AND 223;
  279. END;
  280.  
  281. PROCEDURE SCROLL_LOCK_ON;
  282. VAR
  283.   KEYBOARD       : BYTE;
  284. BEGIN
  285.   KEYBOARD := MEM[SEG0040:$0017];
  286.   KEYBOARD:=KEYBOARD OR 16;
  287. END;
  288.  
  289. PROCEDURE SCROLL_LOCK_OFF;
  290. VAR
  291.   KEYBOARD       : BYTE;
  292. BEGIN
  293.   KEYBOARD := MEM[SEG0040:$0017];
  294.   KEYBOARD:=KEYBOARD AND 239;
  295. END;
  296.  
  297. FUNCTION SCROLL_LOCK_IS_ON : BOOLEAN;
  298. VAR
  299.   KEYBOARD       : BYTE;
  300. BEGIN
  301.   KEYBOARD := MEM[SEG0040:$0017];
  302.   SCROLL_LOCK_IS_ON := KEYBOARD AND 16 = 16;
  303. END;
  304.  
  305. PROCEDURE SHOW_VERSION;
  306. VAR
  307.   CH     : CHAR;
  308.   L      : LONGINT;
  309.   SCREEN : ARRAY [1..355] OF CHAR;
  310.   TEMP   : STRING[15];
  311.   X,Y    : INTEGER;
  312. BEGIN
  313.   X := WHEREX;
  314.   Y := WHEREY;
  315.   MOVE(P^[319],SCREEN[1],71);
  316.   MOVE(P^[479],SCREEN[72],71);
  317.   MOVE(P^[639],SCREEN[143],71);
  318.   MOVE(P^[799],SCREEN[214],71);
  319.   MOVE(P^[959],SCREEN[285],71);
  320.   FW(1,3,$4F,'╒════════════════════════════════╕');
  321.   FW(1,4,$4F,'│                                │');
  322.   IF LENGTH(PARAMSTR(0)) <= 30 THEN
  323.     FW(3,4,$4F,PARAMSTR(0))
  324.   ELSE
  325.     BEGIN
  326.       FW(3,4,$4F,CHR(27)+COPY(PARAMSTR(0),LENGTH(PARAMSTR(0))-28,29));
  327.     END;
  328.   FW(1,5,$4F,'│ U17.6 RELEASE                  │');
  329.   IF BTfiler <> '' THEN
  330.     BEGIN
  331.       FW(1,6,$4F,'│ B-Tree Filer   v               │');
  332.       FW(19,6,$4F,BTfiler);
  333.       FW(1,7,$4F,'╘════════════════════════════════╛');
  334.     END
  335.   ELSE
  336.     FW(1,6,$4F,'╘════════════════════════════════╛');
  337.   IF UT.COMPILED_DATE <> '%%-%%-%%' THEN
  338.     BEGIN
  339.       FW(18,5,$4F,UT.COMPILED_DATE+' ');
  340.       IF UT.COMPILED_TIME <> '%%:%%' THEN
  341.         FW(27,5,$4F,UT.COMPILED_TIME);
  342.     END
  343.   ELSE
  344.     FW(18,5,$4F,VERSION);
  345.   GOTOXY(16,5);
  346.   START_TIMER(L);
  347.   REPEAT
  348.   UNTIL (ELAP_TIME(L) > 15) OR KEYPRESSED OR (COMMAND_BUFFER <> '');
  349.   IF KEYPRESSED THEN
  350.     BEGIN
  351.       READCH(CH,FALSE);
  352.       IF CH = AF1 THEN
  353.         BEGIN
  354.           TEMP := 'Meulpk([éx|fp{';
  355.           UN_ENCRYPT(TEMP,15000);
  356.           FW(1,5,$4F,'│                                │');
  357.           FW(11,5,$4F,TEMP);
  358.           READCHT(CH,FALSE,30);
  359.         END;
  360.     END;
  361.   WHILE KEYPRESSED DO
  362.     CH := READKEY;
  363.   MOVE(SCREEN[1],P^[319],71);
  364.   MOVE(SCREEN[72],P^[479],71);
  365.   MOVE(SCREEN[143],P^[639],71);
  366.   MOVE(SCREEN[214],P^[799],71);
  367.   MOVE(SCREEN[285],P^[959],71);
  368.   GOTOXY(X,Y);
  369. END;
  370.  
  371. PROCEDURE SPECIAL_KEY(VAR CH : CHAR);
  372. BEGIN
  373.   CASE ORD(CH) OF
  374.        72  : CH:=#180; { UP ARROW    }
  375.        80  : CH:=#181; { DOWN ARROW  }
  376.        77  : CH:=#192; { RIGHT ARROW }
  377.        75  : CH:=#191; { LEFT ARROW  }
  378.        71  : CH:=#196; { HOME KEY    }    { ESC KEY RETURNS CHR(27) }
  379.        73  : CH:=#178; { PGUP KEY    }
  380.        79  : CH:=#197; { END KEY     }
  381.        81  : CH:=#179; { PGDN KEY    }
  382.        82  : CH:=#198; { INSERT KEY  }
  383.        83  : CH:=#199; { DELETE KEY  }
  384.        59  : CH:=#127; { F1 }
  385.        60  : CH:=#128; { F2 }
  386.        61  : CH:=#129; { F3 }
  387.        62  : CH:=#130; { F4 }
  388.        63  : CH:=#131; { F5 }
  389.        64  : CH:=#132; { F6 }
  390.        65  : CH:=#133; { F7 }
  391.        66  : CH:=#134; { F8 }
  392.        67  : CH:=#135; { F9 }
  393.        68  : CH:=#136; { F10 }
  394.        104 : CH:=#139; { ALT F1 }
  395.        105 : CH:=#140; { ALT F2 }
  396.        106 : CH:=#141; { ALT F3 }
  397.        107 : CH:=#142; { ALT F4 }
  398.        108 : CH:=#143; { ALT F5 }
  399.        109 : CH:=#144; { ALT F6 }
  400.        110 : CH:=#145; { ALT F7 }
  401.        111 : CH:=#146; { ALT F8 }
  402.        112 : CH:=#147; { ALT F9 }
  403.        113 : CH:=#148; { ALT F10}
  404.        30  : CH:=#151; { ALT A  }
  405.        48  : CH:=#152; { ALT B  }
  406.        46  : CH:=#153; { ALT C  }
  407.        32  : CH:=#154; { ALT D  }
  408.        18  : CH:=#155; { ALT E  }
  409.        33  : CH:=#156; { ALT F  }
  410.        34  : CH:=#157; { ALT G  }
  411.        35  : CH:=#158; { ALT H  }
  412.        23  : CH:=#159; { ALT I  }
  413.        36  : CH:=#160; { ALT J  }
  414.        37  : CH:=#161; { ALT K  }
  415.        38  : CH:=#162; { ALT L  }
  416.        50  : CH:=#163; { ALT M  }
  417.        49  : CH:=#164; { ALT N  }
  418.        24  : CH:=#165; { ALT O  }
  419.        25  : CH:=#166; { ALT P  }
  420.        16  : CH:=#167; { ALT Q  }
  421.        19  : CH:=#168; { ALT R  }
  422.        31  : CH:=#169; { ALT S  }
  423.        20  : CH:=#170; { ALT T  }
  424.        22  : CH:=#171; { ALT U  }
  425.        47  : CH:=#172; { ALT V  }
  426.        17  : CH:=#173; { ALT W  }
  427.        45  : CH:=#174; { ALT X  }
  428.        21  : CH:=#175; { ALT Y  }
  429.        44  : CH:=#176; { ALT Z  }
  430.        94  : CH:=#200; { CNTR F1 }
  431.        95  : CH:=#201;
  432.        96  : CH:=#202;
  433.        97  : CH:=#203;
  434.        98  : CH:=#204;
  435.        99  : CH:=#205;
  436.       100  : CH:=#206;
  437.       101  : CH:=#207;
  438.       102  : CH:=#208;
  439.       103  : CH:=#209;
  440.        15  : CH:=#212;
  441.   END;
  442. END;                              
  443.  
  444. Procedure PROCESS_COMMAND(UserRoutine : Pointer; NA : STRING);
  445.   Procedure CallUserRoutine (NA : STRING); INLINE
  446.     ( $FF / $5E / <UserRoutine );
  447. Begin
  448.   CallUserRoutine(NA);
  449. End;
  450.  
  451. PROCEDURE EVENT_HANDLER(PROCESS_ROUTINE : POINTER; MASK : STRING);
  452. BEGIN
  453.   PROCESS_COMMAND(PROCESS_ROUTINE,'');
  454. END;
  455.  
  456. PROCEDURE BLANK_SCREEN;
  457. VAR
  458.   SC        : BUFFER;
  459.   I,J,X,Y   : INTEGER;
  460.   ATX,ATY   : INTEGER;
  461.   TIM       : LONGINT;
  462.   SAVECUR   : CURTYPE;
  463.   SAVE_ATTR : BYTE;
  464.   SETimer   : LONGINT;
  465. BEGIN
  466.   ATX := WHEREX;
  467.   ATY := WHEREY;
  468.   SAVECUR := CUR;
  469.   SET_CURSOR(NONE);
  470.   SAVE_SCREEN(SC);
  471.   SAVE_ATTR := TEXTATTR;
  472.   TEXTATTR := $07;
  473.   WRITE_DATE(0,0,'N');
  474.   CH := 'X';
  475.   START_TIMER(SETimer);
  476.   REPEAT
  477.     CLRSCR;
  478.     START_TIMER(TIM);
  479.     X := RANDOM(60)+1;
  480.     Y := RANDOM(21)+1;
  481.     FW(X,Y  ,$1F,'                   ');
  482.     WRITE_TIME(X+6,Y,UT.TIME_TYPE);
  483.     FW(X,Y+1,$3F,' Press <space bar> ');
  484.     FW(X,Y+2,$1F,'                   ');
  485.     FW(X,Y+3,$8F,PAD(BLANK_MESS,19));
  486.     WRITE_DATE(X+6,Y+2,'N');
  487.     REPEAT
  488.     UNTIL KEYPRESSED OR (ELAP_TIME(TIM) > 30) OR (COMMAND_BUFFER <> '');
  489.     IF (ScreenEvent <> NIL) AND (ELAP_TIME(SETimer) > ScreenEventTimer) THEN
  490.       BEGIN
  491.         EVENT_HANDLER(ScreenEvent,'');
  492.         START_TIMER(SETimer);
  493.       END;
  494.     WHILE KEYPRESSED DO
  495.       CH := READKEY;
  496.   UNTIL (CH = ' ') OR (CH = ESCAPE) OR (COMMAND_BUFFER <> '');
  497.   REBUILD_SCREEN(SC);
  498.   WRITE_TIME(UT.TIMEX,UT.TIMEY,UT.TIME_TYPE);
  499.   WRITE_DATE(UT.DATEX,UT.DATEY,UT.DATE_TYPE);
  500.   GOTOXY43(ATX,ATY);
  501.   SET_CURSOR(SAVECUR);
  502.   TEXTATTR := SAVE_ATTR;
  503. END;
  504.  
  505. PROCEDURE READCH;
  506. VAR
  507.   I,
  508.   ATX, ATY : INTEGER;
  509.   LINE25   : BUF160;
  510.   HELP     : BOOLEAN;
  511.   TSTART   : LONGINT;
  512.   TEMP     : STRING[3];
  513.  
  514.  
  515. BEGIN
  516.   ATX := WHEREX;
  517.   ATY := WHEREY;
  518.   SAVE_LINE(25,LINE25);
  519.   HELP := FALSE;
  520.   START_TIMER(TSTART);
  521.   REPEAT
  522.     I := 300;
  523.     REPEAT
  524.       IF (SHIFT_KEYS('A')) AND (HELP_LINE <> '') THEN
  525.         BEGIN
  526.           FW(1,25,HELP_ATTR,PAD(HELP_LINE,80));
  527.           GOTOXY(ATX,ATY);
  528.           HELP := TRUE;
  529.         END
  530.       ELSE
  531.         IF (SHIFT_KEYS('C')) AND (HELP_LINE2 <> '') THEN
  532.           BEGIN
  533.             FW(1,25,HELP_ATTR2,PAD(HELP_LINE2,80));
  534.             GOTOXY(ATX,ATY);
  535.             HELP := TRUE;
  536.           END
  537.         ELSE
  538.           IF HELP THEN
  539.             BEGIN
  540.               REBUILD_LINE(25,LINE25);
  541.               GOTOXY(ATX,ATY);
  542.               HELP := FALSE;
  543.             END;
  544.       IF UT.TIMEX > 0 THEN
  545.         BEGIN
  546.           I := SUCC(I);
  547.           IF I > 200 THEN
  548.             BEGIN
  549.               WRITE_TIME(UT.TIMEX,UT.TIMEY,UT.TIME_TYPE);
  550.               I := 0;
  551.             END;
  552.           GOTOXY43(ATX,ATY);
  553.         END;
  554.       IF (SCREEN_BLANKER > 0) AND (ELAP_TIME(TSTART) > SCREEN_BLANKER) THEN
  555.         BEGIN
  556.           GOTOXY43(ATX,ATY);
  557.           BLANK_SCREEN;
  558.           START_TIMER(TSTART);
  559.         END;
  560.     UNTIL KEYPRESSED OR (COMMAND_BUFFER <> '');
  561.     REBUILD_LINE(25,LINE25);
  562.     HELP := FALSE;
  563.     IF COMMAND_BUFFER = '' THEN
  564.       BEGIN
  565.         CH := READKEY;
  566.         IF CH = #0 THEN
  567.           BEGIN
  568.             CH := READKEY;
  569.             SPECIAL_KEY(CH);
  570.           END;
  571.         IF (CH IN [' '..'~']) AND ECHO THEN
  572.           WRITE(CH);
  573.       END
  574.     ELSE
  575.       BEGIN
  576.         CH := COMMAND_BUFFER[1];
  577.         DELETE(COMMAND_BUFFER,1,1);
  578.         IF (CH IN [' '..'~']) AND ECHO THEN
  579.           WRITE(CH);
  580.         IF CH = #255 THEN
  581.           BEGIN
  582.             START_TIMER(TSTART);
  583.             TEMP[0] := #3;
  584.             TEMP[1] := COMMAND_BUFFER[1];
  585.             DELETE(COMMAND_BUFFER,1,1);
  586.             TEMP[2] := COMMAND_BUFFER[1];
  587.             DELETE(COMMAND_BUFFER,1,1);
  588.             TEMP[3] := COMMAND_BUFFER[1];
  589.             DELETE(COMMAND_BUFFER,1,1);
  590.             REPEAT UNTIL ELAP_TIME(TSTART) = _LONGINT(TEMP);
  591.           END;
  592.       END;
  593.     IF CH = AF10 THEN SHOW_VERSION;
  594.     IF EventHandler <> NIL THEN
  595.       EVENT_HANDLER(EventHandler,'');
  596.   UNTIL (CH <> AF10) AND (CH <> #255);
  597. END;
  598.  
  599. FUNCTION PRINTER_NOT_READY : BOOLEAN;
  600. VAR
  601.   REGS         : REGISTERS;
  602. BEGIN
  603.   PRINTER_NOT_READY := TRUE;
  604.   FILLCHAR(REGS,SIZEOF(REGS),00);
  605.   WITH REGS DO
  606.     BEGIN
  607.       AX := $0200;
  608.       DX := 0;     { LPT1 = 0, LPT2 = 1 }
  609.     END;
  610.   INTR($17,REGS);
  611.   IF REGS.AX AND $4000 = 0 THEN
  612.     BEGIN
  613.       IF REGS.AX AND $1000 <> 0 THEN PRINTER_NOT_READY := FALSE;
  614.     END;
  615.   IF REGS.AX AND $8000 = 0 THEN PRINTER_NOT_READY := TRUE;
  616. END;
  617.  
  618. PROCEDURE SET_ATTR;
  619. VAR
  620.   MONITOR_INFO : BYTE ABSOLUTE $0040:$0010;
  621.   SCREEN1      : ARRAY [1..4000] OF BYTE ABSOLUTE $B800:$0000;
  622.   SCREEN2      : ARRAY [1..4000] OF BYTE ABSOLUTE $B000:$0000;
  623.   I,Z          : INTEGER;
  624. BEGIN
  625.   FOR I := 1 TO 80 DO
  626.     IF I IN X THEN
  627.       BEGIN
  628.         Z := ((Y * 160) - 160) + (I * 2);
  629.         IF MONITOR_INFO AND 48=48 THEN
  630.           SCREEN2[Z] := ATTRIB
  631.         ELSE
  632.           IF MONITOR_INFO AND 32=32 THEN
  633.             SCREEN1[Z] := ATTRIB;
  634.       END;
  635. END;
  636.  
  637. PROCEDURE SET_ATTR_BUFFER;
  638. VAR
  639.   I,Z          : INTEGER;
  640. BEGIN
  641.   FOR I := 1 TO 80 DO
  642.     IF I IN X THEN
  643.       BEGIN
  644.         Z := ((Y * 160) - 160) + (I * 2);
  645.         SC[Z] := CHAR(ATTRIB);
  646.       END;
  647. END;
  648.  
  649. PROCEDURE WRITE_TIME;
  650. VAR
  651.   IND,TEMP             : STR8;
  652.   HR, MIN, SEC, SEC100 : WORD;
  653.   C                    : CURTYPE;
  654.   SAVE_ATTR            : BYTE;
  655.   SX, SY               : INTEGER;
  656. BEGIN
  657.   GETTIME(HR,MIN,SEC,SEC100);
  658.   IND := '  ';
  659.   NOW := (HR * 60) + MIN;
  660.   IF NOT (MILITARY IN ['M','m']) THEN
  661.     BEGIN
  662.       IF HR > 12 THEN
  663.         BEGIN
  664.           HR := HR - 12;
  665.           IND := 'pm';
  666.         END
  667.       ELSE
  668.         IF HR = 12 THEN
  669.           IND := 'pm'
  670.         ELSE
  671.           IND := 'am';
  672.     END;
  673.   STR(HR:2,TIME);
  674.   IF (TIME[1] = ' ') AND (MILITARY IN ['M','n']) THEN TIME[1] := '0';
  675.   STR(MIN:2,TEMP);
  676.   IF TEMP[1] = ' ' THEN TEMP[1] := '0';
  677.   TIME := TIME + ':' + TEMP;
  678.   IF NOT (MILITARY IN ['M','m']) THEN
  679.     TIME := TIME + ' ' + IND;
  680.   IF X <> 0 THEN
  681.     BEGIN
  682.       C := CUR;
  683.       SX := WHEREX;
  684.       SY := WHEREY;
  685.       SET_CURSOR(NONE);
  686.       SAVE_ATTR := CRT.TEXTATTR;
  687.       CRT.TEXTATTR := SCREEN_ATTR(X,Y);
  688.       GOTOXY43(X,Y);
  689.       WRITE(COPY(TIME,1,2));
  690.       IF BLINK_IS_ON THEN
  691.         CRT.TEXTATTR := CRT.TEXTATTR + BLINK;
  692.       WRITE(':');
  693.       IF BLINK_IS_ON THEN
  694.         CRT.TEXTATTR := CRT.TEXTATTR - BLINK;
  695.       WRITE(COPY(TIME,4,5));
  696.       CRT.TEXTATTR := SAVE_ATTR;
  697.       GOTOXY(SX,SY);
  698.       SET_CURSOR(C);
  699.     END;
  700. END;
  701.  
  702. PROCEDURE WRITE_DATE;
  703. VAR
  704.   TEMP         : STRING[9];
  705.   YR, MO, DAY  : WORD;
  706. BEGIN
  707.   GETDATE(YR,MO,DAY,DOW);
  708.   IF WORDS IN ['W','w','D','d'] THEN
  709.     BEGIN
  710.       CASE MO OF
  711.             1 : DATE := 'January ';
  712.             2 : DATE := 'February ';
  713.             3 : DATE := 'March ';
  714.             4 : DATE := 'April ';
  715.             5 : DATE := 'May ';
  716.             6 : DATE := 'June ';
  717.             7 : DATE := 'July ';
  718.             8 : DATE := 'August ';
  719.             9 : DATE := 'September ';
  720.            10 : DATE := 'October ';
  721.            11 : DATE := 'November ';
  722.            12 : DATE := 'December ';
  723.       END;
  724.       STR(DAY:2,TEMP);
  725.       DATE := DATE + TEMP;
  726.       STR(YR:4,TEMP);
  727.       DATE := DATE + ', '+TEMP;
  728.       IF WORDS IN ['D','d'] THEN
  729.         BEGIN
  730.           CASE DOW OF
  731.               0 : TEMP := 'Sunday';
  732.               1 : TEMP := 'Monday';
  733.               2 : TEMP := 'Tuesday';
  734.               3 : TEMP := 'Wednesday';
  735.               4 : TEMP := 'Thursday';
  736.               5 : TEMP := 'Friday';
  737.               6 : TEMP := 'Saturday';
  738.           END;
  739.           DATE := TEMP + ' ' + DATE;
  740.         END;
  741.     END
  742.       ELSE
  743.         BEGIN
  744.           IF YR > 2000 THEN
  745.             YR := YR - 2000
  746.           ELSE
  747.             YR := YR - 1900;
  748.           STR(MO:2,DATE);
  749.           IF DATE[1] = ' ' THEN DATE[1] := '0';
  750.           STR(DAY:2,TEMP);
  751.           IF TEMP[1] = ' ' THEN TEMP[1] := '0';
  752.           DATE := DATE + '-' + TEMP + '-';
  753.           STR(YR:2,TEMP);
  754.           IF TEMP[1] = ' ' THEN TEMP[1] := '0';
  755.           DATE := DATE + TEMP;
  756.         END;
  757.   IF X <> 0 THEN
  758.     FW(X,Y,SCREEN_ATTR(X,Y),DATE);
  759. END;
  760.  
  761. PROCEDURE FW(X,Y : INTEGER; ATTR : BYTE; LINE : STR80);
  762. VAR
  763.   I,J,
  764.   Z : INTEGER;
  765. BEGIN
  766.   Z := (((Y * 160) - 160) + (X * 2)) - 1;
  767.   I := 1;
  768.   J := 1;
  769.   REPEAT
  770.     P^[Z+J-1] := LINE[I];
  771.     P^[Z+J]   := CHR(ATTR);
  772.     I := I + 1;
  773.     J := J + 2;
  774.   UNTIL I > LENGTH(LINE);
  775. END;
  776.  
  777. FUNCTION WHOAMI;
  778. BEGIN
  779.   WHOAMI := PARAMSTR(0);
  780. END;
  781.  
  782. PROCEDURE START_TIMER;
  783. VAR
  784.   TIME1     : DATETIME;
  785.   SEC100,
  786.   DAYOFWEEK : WORD;
  787. BEGIN
  788.   WITH TIME1 DO
  789.     GETDATE(YEAR,MONTH,DAY,DAYOFWEEK);
  790.   WITH TIME1 DO
  791.     GETTIME(HOUR,MIN,SEC,SEC100);
  792.   PACKTIME(TIME1,T);
  793. END;
  794.  
  795. FUNCTION ELAP_TIME;
  796. VAR
  797.   TIME1,
  798.   TIME2     : DATETIME;
  799.   SEC100,
  800.   DAYOFWEEK : WORD;
  801.   L,M,N     : LONGINT;
  802.   R         : REAL;
  803.  
  804.        FUNCTION JULIAN(T : DATETIME) : REAL;
  805.        VAR
  806.           TEMP : REAL;
  807.        BEGIN
  808.           TEMP   := INT((T.MONTH - 14.0) / 12.0);
  809.           JULIAN := T.DAY - 32075.0 +
  810.                     INT(1461.0 * (T.YEAR + 4800.0 + TEMP) / 4.0) +
  811.                     INT(367.0 * (T.MONTH - 2.0 - TEMP * 12.0) / 12.0) -
  812.                     INT(3.0 * INT((T.YEAR + 4900.0 + TEMP) / 100.0) / 4.0)
  813.        END;
  814. BEGIN
  815.   WITH TIME1 DO
  816.     GETDATE(YEAR,MONTH,DAY,DAYOFWEEK);
  817.   WITH TIME1 DO
  818.     GETTIME(HOUR,MIN,SEC,SEC100);
  819.   UNPACKTIME(T,TIME2);
  820.   R := JULIAN(TIME1)-JULIAN(TIME2);
  821.   L := TRUNC(R * 864.0 * 100.0);
  822.   M := TIME1.HOUR * 60;
  823.   M := (M + TIME1.MIN) * 60;
  824.   M := M + TIME1.SEC;
  825.   N := TIME2.HOUR * 60;
  826.   N := (N + TIME2.MIN) * 60;
  827.   N := N + TIME2.SEC;
  828.   ELAP_TIME := L + M - N;
  829. END;
  830.  
  831. FUNCTION ELAP_TIME_STR;
  832. VAR
  833.   D,H,M,S : LONGINT;
  834.   T       : LONGINT;
  835.   ST      : STRING;
  836. BEGIN
  837.   T  := ELAP_TIME(TIM);
  838.   D  := T DIV 86400;
  839.   T  := T MOD 86400;
  840.   H  := T DIV 3600;
  841.   T  := T MOD 3600;
  842.   M  := T DIV 60;
  843.   S  := T MOD 60;
  844.   IF D > 0 THEN
  845.     BEGIN
  846.       ST := LONGINT_STR(D,1);
  847.       IF D = 1 THEN
  848.         ST := ST + ' day, '
  849.       ELSE
  850.         ST := ST + ' days, ';
  851.     END
  852.   ELSE
  853.     ST := '';
  854.   IF (D > 0) OR (H > 0) THEN
  855.     BEGIN
  856.       ST := ST + LONGINT_STR(H,2);
  857.       IF H = 1 THEN
  858.         ST := ST + ' hour, '
  859.       ELSE
  860.         ST := ST + ' hours, ';
  861.     END;
  862.   IF (D > 0) OR (H > 0) OR (M > 0) THEN
  863.     ST := ST + LONGINT_STR(M,2) + ' min, ';
  864.   ST := ST + LONGINT_STR(S,2) + ' sec';
  865.   ELAP_TIME_STR := PAD(ST,35);
  866. END;
  867.  
  868. FUNCTION PAD;
  869. VAR
  870.   I : INTEGER;
  871. BEGIN
  872.   I := 1;
  873.   IF LENGTH(S) < LEN THEN
  874.     S := S + SPACES(LEN - LENGTH(S));
  875.   IF LENGTH(S) > LEN THEN
  876.     S[0] := CHR(LEN);
  877.   WHILE POS(#0,S) > 0 DO
  878.     S[POS(#0,S)] := ' ';
  879.   PAD := S;
  880. END;
  881.  
  882. FUNCTION PAD_LEFT;
  883. BEGIN
  884.   IF LENGTH(S) < LEN THEN
  885.     S := SPACES(LEN - LENGTH(S)) + S;
  886.   IF LENGTH(S) > LEN THEN
  887.     S[0] := CHR(LEN);
  888.   PAD_LEFT := S;
  889. END;
  890.  
  891. FUNCTION PAD_CH;
  892. BEGIN
  893.   IF LENGTH(S) < LEN THEN
  894.     S := S + DUP(CH,LEN - LENGTH(S));
  895.   IF LENGTH(S) > LEN THEN
  896.     S[0] := CHR(LEN);
  897.   PAD_CH := S;
  898. END;
  899.  
  900. FUNCTION  PAD_CH_LEFT(S : STRING; LEN : INTEGER; CH : CHAR) : STRING;
  901. BEGIN
  902.   IF LENGTH(S) < LEN THEN
  903.     S := DUP(CH,LEN - LENGTH(S)) + S;
  904.   IF LENGTH(S) > LEN THEN
  905.     S[0] := CHR(LEN);
  906.   PAD_CH_LEFT := S;
  907. END;
  908.  
  909. FUNCTION SPACES;
  910. VAR
  911.   S : STRING;
  912. BEGIN
  913.   S[0] := CHR(NUM);
  914.   FILLCHAR(S[1], NUM, ' ');
  915.   SPACES := S;
  916. END;
  917.  
  918. FUNCTION UPPERCASE;
  919. VAR
  920.   COUNTER : WORD;
  921. BEGIN
  922.   FOR COUNTER := 1 TO LENGTH(S) DO
  923.     S[COUNTER] := UPCASE(S[COUNTER]);
  924.   UPPERCASE := S;
  925. END;
  926.  
  927. FUNCTION EGA_INSTALLED : BOOLEAN;
  928. VAR
  929.   REG : REGISTERS;
  930. BEGIN
  931.   REG.AX := $1200;
  932.   REG.BX := $0010;
  933.   REG.CX := $FFFF;
  934.   INTR($10, REG);
  935.   EGA_INSTALLED := REG.CX <> $FFFF;
  936. END;
  937.  
  938. FUNCTION VGA_INSTALLED : BOOLEAN;
  939. VAR
  940.   REGS : REGISTERS;
  941. BEGIN
  942.   REGS.AX := $1A00;
  943.   INTR($10,REGS);
  944.   VGA_INSTALLED := (REGS.AL = $1A);
  945. END;
  946.  
  947. PROCEDURE LINES43;
  948. BEGIN
  949.   IF EGA_PRESENT THEN
  950.     TEXTMODE(CO80 + FONT8X8);
  951. END;
  952.  
  953. PROCEDURE GOTOXY43;
  954. VAR
  955.   I : INTEGER;
  956.   C : CURTYPE;
  957. BEGIN
  958.   C := CUR;
  959.   IF Y < 26 THEN
  960.     GOTOXY(X,Y)
  961.   ELSE
  962.     IF LASTMODE = 259 THEN
  963.       BEGIN
  964.         I := 25;
  965.         SET_CURSOR(NONE);
  966.         GOTOXY(X,25);
  967.         WHILE I < Y DO
  968.           BEGIN
  969.             WRITE(CHR(10));
  970.             I := SUCC(I);
  971.           END;
  972.         SET_CURSOR(C);
  973.       END;
  974. END;
  975.  
  976. PROCEDURE LINES25;
  977. BEGIN
  978.   TEXTMODE(CO80);
  979. END;
  980.  
  981. PROCEDURE READCHTIME;
  982. VAR
  983.   I,
  984.   ATX, ATY : INTEGER;
  985.   HELP     : BOOLEAN;
  986.   LINE25   : BUF160;
  987. BEGIN
  988.   ATX := WHEREX;
  989.   ATY := WHEREY;
  990.   HELP := FALSE;
  991.   SAVE_LINE(25,LINE25);
  992.   I := 300;
  993.   REPEAT
  994.     I := SUCC(I);
  995.     IF (SHIFT_KEYS('A')) AND (HELP_LINE <> '') THEN
  996.       BEGIN
  997.         FW(1,25,HELP_ATTR,PAD(HELP_LINE,80));
  998.         GOTOXY(ATX,ATY);
  999.         HELP := TRUE;
  1000.       END
  1001.     ELSE
  1002.       IF (SHIFT_KEYS('C')) AND (HELP_LINE2 <> '') THEN
  1003.         BEGIN
  1004.           FW(1,25,HELP_ATTR2,PAD(HELP_LINE2,80));
  1005.           GOTOXY(ATX,ATY);
  1006.           HELP := TRUE;
  1007.         END
  1008.       ELSE
  1009.         IF HELP THEN
  1010.           BEGIN
  1011.             REBUILD_LINE(25,LINE25);
  1012.             GOTOXY(ATX,ATY);
  1013.             HELP := FALSE;
  1014.           END;
  1015.     IF I > 200 THEN
  1016.       BEGIN
  1017.         WRITE_TIME(X,Y,UT.TIME_TYPE);
  1018.         I := 0;
  1019.       END;
  1020.     GOTOXY43(ATX,ATY);
  1021.   UNTIL KEYPRESSED OR (COMMAND_BUFFER <> '');
  1022.   REBUILD_LINE(25,LINE25);
  1023.   READCH(CH,ECHO);
  1024. END;
  1025.  
  1026. PROCEDURE READSTR;
  1027. VAR
  1028.   I,
  1029.   START  : INTEGER;
  1030.   CAPIT,
  1031.   CAPWO,
  1032.   INSON  : BOOLEAN;
  1033.   SAVECH : CHAR;
  1034.   SX, SY : INTEGER;
  1035.  
  1036.        FUNCTION EDIT_ALL : BOOLEAN;
  1037.        VAR
  1038.          I : INTEGER;
  1039.        BEGIN
  1040.          EDIT_ALL := TRUE;
  1041.          FOR I := 1 TO LEN DO
  1042.            IF NOT (I IN CANEDIT) THEN
  1043.              EDIT_ALL := FALSE;
  1044.        END;
  1045.  
  1046. BEGIN
  1047.   OLDVAL := INSTRING;
  1048.   INSON := FALSE;
  1049.   IF YLOC > 199 THEN
  1050.     BEGIN
  1051.       CAPIT := TRUE;
  1052.       YLOC := YLOC - 200;
  1053.     END
  1054.   ELSE
  1055.     BEGIN
  1056.       CAPIT := FALSE;
  1057.       IF YLOC > 99 THEN
  1058.         BEGIN
  1059.           YLOC := YLOC - 100;
  1060.           CAPWO := TRUE;
  1061.         END
  1062.       ELSE
  1063.         CAPWO := FALSE;
  1064.     END;
  1065.   IF CLEAR IN EXITCH THEN
  1066.     INSTRING := SPACES(LEN)
  1067.   ELSE
  1068.     INSTRING := PAD(INSTRING,LEN);
  1069.   FW(X,Y,PATTR,PROMPT);
  1070.   START := X + LENGTH(PROMPT);
  1071.   X := X_IN;
  1072.   FW(START,Y,IATTR,INSTRING);
  1073.   WHILE (NOT (X IN CANEDIT)) AND
  1074.         (X <= LEN + START) DO
  1075.     X := SUCC(X);
  1076.   IF XLOC > 99 THEN
  1077.     BEGIN
  1078.       X := LEN;
  1079.       XLOC := XLOC - 100;
  1080.     END;
  1081.   WHILE NOT (X IN CANEDIT) DO
  1082.     X := PRED(X);
  1083.   SET_CURSOR(UNDERLINE);
  1084.   SX := UT.TIMEX;
  1085.   SY := UT.TIMEY;
  1086.   UT.TIMEX := XLOC;
  1087.   UT.TIMEY := YLOC;
  1088.   IF NOT (DISPLAY IN EXITCH) THEN
  1089.     REPEAT
  1090.       GOTOXY(START+X-1,Y);
  1091.       CH := CH1;
  1092.       READCH(CH,FALSE);
  1093.       SAVECH := CH;
  1094.       CASE CH OF
  1095.           HOMEKEY : BEGIN
  1096.                       X := 1;
  1097.                       WHILE (NOT (X IN CANEDIT)) AND
  1098.                             (X <= LEN + START) DO
  1099.                         X := SUCC(X);
  1100.                     END;
  1101.            ENDKEY : BEGIN
  1102.                       X := LEN;
  1103.                       WHILE (X > 2) AND (INSTRING[X-1] = ' ') DO
  1104.                         X := PRED(X);
  1105.                       WHILE (NOT (X IN CANEDIT)) AND
  1106.                             (X <= LEN) DO
  1107.                         X := SUCC(X);
  1108.                       WHILE NOT (X IN CANEDIT) DO
  1109.                         X := PRED(X);
  1110.                       IF X < 1 THEN
  1111.                         X := 1
  1112.                       ELSE
  1113.                         IF (X = 2) AND (INSTRING[1] = ' ') AND
  1114.                            (1 IN CANEDIT) THEN
  1115.                           X := 1;
  1116.                     END;
  1117.                #8 : IF (X > 1) AND EDIT_ALL THEN
  1118.                       BEGIN
  1119.                         DELETE(INSTRING,X-1,1);
  1120.                         INSTRING := INSTRING + ' ';
  1121.                         FW(START,Y,IATTR,INSTRING);
  1122.                         X := PRED(X);
  1123.                         WHILE (NOT (X IN CANEDIT)) AND
  1124.                               (X > 1) DO
  1125.                           X := PRED(X);
  1126.                         WHILE NOT (X IN CANEDIT) DO
  1127.                           X := SUCC(X);
  1128.                       END
  1129.                     ELSE
  1130.                       IF X > 1 THEN
  1131.                         BEGIN
  1132.                           X := PRED(X);
  1133.                           WHILE (NOT (X IN CANEDIT)) AND
  1134.                                 (X > 1) DO
  1135.                             X := PRED(X);
  1136.                           WHILE NOT (X IN CANEDIT) DO
  1137.                             X := SUCC(X);
  1138.                         END
  1139.                       ELSE
  1140.                         BEGIN
  1141.                           SAVECH := CH;
  1142.                           IF NOCONV IN EXITCH THEN
  1143.                             CH := NOCONV
  1144.                           ELSE
  1145.                             CH := UP;
  1146.                         END;
  1147.             RIGHT : IF X < LEN THEN
  1148.                       BEGIN
  1149.                         X := SUCC(X);
  1150.                         WHILE (NOT (X IN CANEDIT)) AND
  1151.                               (X <= LEN + START) DO
  1152.                           X := SUCC(X);
  1153.                         IF NOT (X IN CANEDIT) THEN
  1154.                           IF NOCONV IN EXITCH THEN
  1155.                             BEGIN
  1156.                               SAVECH := RIGHT;
  1157.                               CH := NOCONV;
  1158.                             END
  1159.                           ELSE
  1160.                             CH := DOWN;
  1161.                         WHILE NOT (X IN CANEDIT) DO
  1162.                           X := PRED(X);
  1163.                       END
  1164.                     ELSE
  1165.                       BEGIN
  1166.                         SAVECH := CH;
  1167.                         IF NOCONV IN EXITCH THEN
  1168.                           CH := NOCONV
  1169.                         ELSE
  1170.                           CH := DOWN;
  1171.                       END;
  1172.              LEFT : IF X > 1 THEN
  1173.                       BEGIN
  1174.                         X := PRED(X);
  1175.                         WHILE (NOT (X IN CANEDIT)) AND
  1176.                               (X > 1) DO
  1177.                           X := PRED(X);
  1178.                         IF NOT (X IN CANEDIT) THEN
  1179.                           IF NOCONV IN EXITCH THEN
  1180.                             BEGIN
  1181.                               SAVECH := LEFT;
  1182.                               CH := NOCONV;
  1183.                             END
  1184.                           ELSE
  1185.                             CH := UP;
  1186.                         WHILE NOT (X IN CANEDIT) DO
  1187.                           X := SUCC(X);
  1188.                       END
  1189.                     ELSE
  1190.                       BEGIN
  1191.                         SAVECH := CH;
  1192.                         IF NOCONV IN EXITCH THEN
  1193.                           CH := NOCONV
  1194.                         ELSE
  1195.                           CH := UP;
  1196.                       END;
  1197.          ' '..'~' : IF CH IN VALID THEN
  1198.                       IF INSON THEN
  1199.                         BEGIN
  1200.                           DELETE(INSTRING,LENGTH(INSTRING),1);
  1201.                           IF (CAPWO AND ((X = 1) OR (INSTRING[X-1] = ' '))) OR
  1202.                              CAPIT THEN
  1203.                             CH := UPCASE(CH);
  1204.                           INSERT(CH,INSTRING,X);
  1205.                           X := SUCC(X);
  1206.                           IF X > LEN THEN
  1207.                             CH := DOWN;
  1208.                           WHILE (NOT (X IN CANEDIT)) AND
  1209.                                 (X <= LEN + START) DO
  1210.                             X := SUCC(X);
  1211.                           WHILE NOT (X IN CANEDIT) DO
  1212.                             X := PRED(X);
  1213.                           FW(START,Y,IATTR,INSTRING);
  1214.                         END
  1215.                       ELSE
  1216.                         BEGIN
  1217.                           IF (CAPWO AND ((X = 1) OR (INSTRING[X-1] = ' '))) OR
  1218.                              CAPIT THEN
  1219.                             CH := UPCASE(CH);
  1220.                           INSTRING[X] := CH;
  1221.                           FW(START+X-1,Y,IATTR,CH);
  1222.                           X := SUCC(X);
  1223.                           IF X > LEN THEN
  1224.                             BEGIN
  1225.                               SAVECH := RIGHT;
  1226.                               IF NOCONV IN EXITCH THEN
  1227.                                 CH := NOCONV
  1228.                               ELSE
  1229.                                 CH := DOWN;
  1230.                             END;
  1231.                           WHILE (NOT (X IN CANEDIT)) AND
  1232.                                 (X <= LEN + START) DO
  1233.                             X := SUCC(X);
  1234.                           IF NOT (X IN CANEDIT) THEN
  1235.                             IF NOCONV IN EXITCH THEN
  1236.                               BEGIN
  1237.                                 SAVECH := RIGHT;
  1238.                                 CH := NOCONV;
  1239.                               END
  1240.                             ELSE
  1241.                               CH := DOWN;
  1242.                           WHILE NOT (X IN CANEDIT) DO
  1243.                             X := PRED(X);
  1244.                         END;
  1245.            INSKEY : BEGIN
  1246.                       INSON := NOT INSON;
  1247.                       IF INSON AND (EDIT_ALL) THEN
  1248.                         SET_CURSOR(BLOCK)
  1249.                       ELSE
  1250.                         BEGIN
  1251.                           SET_CURSOR(UNDERLINE);
  1252.                           INSON := FALSE;
  1253.                         END;
  1254.                     END;
  1255.            DELKEY : IF EDIT_ALL THEN
  1256.                       BEGIN
  1257.                         DELETE(INSTRING,X,1);
  1258.                         INSTRING := INSTRING + ' ';
  1259.                         GOTOXY(START,Y);
  1260.                         FW(START,Y,IATTR,INSTRING);
  1261.                       END;
  1262.             ALT_C : BEGIN
  1263.                       FOR I := 1 TO LEN DO
  1264.                         IF I IN CANEDIT THEN
  1265.                           INSTRING[I] := ' ';
  1266.                       X := 1;
  1267.                       FW(START,Y,IATTR,INSTRING);
  1268.                       WHILE (NOT (X IN CANEDIT)) AND
  1269.                             (X <= LEN + START) DO
  1270.                         X := SUCC(X);
  1271.                     END;
  1272.       END;
  1273.       IF X > LEN THEN X := LEN;
  1274.     UNTIL (CH = #27) OR (CH IN EXITCH);
  1275.   UT.TIMEX := SX;
  1276.   UT.TIMEY := SY;
  1277.   IF NOCONV IN EXITCH THEN
  1278.     CH := SAVECH;
  1279.   X_OUT := X;
  1280.   X_IN  := 1;
  1281.   SET_CURSOR(UNDERLINE);
  1282.   CHANGED := INSTRING <> OLDVAL;
  1283. END;
  1284.  
  1285. PROCEDURE READ_STR;
  1286. VAR
  1287.   I,
  1288.   LEN,
  1289.   START   : INTEGER;
  1290.   CAPWO,
  1291.   VALID,
  1292.   EDITALL,
  1293.   INSON   : BOOLEAN;
  1294.   SAVECH  : CHAR;
  1295.   OLDATTR : BYTE;
  1296.   OLDCUR  : CURTYPE;
  1297.  
  1298.          FUNCTION CANEDIT(INCHAR : CHAR) : BOOLEAN;
  1299.          BEGIN
  1300.            IF ((INCHAR = ' ') OR
  1301.                (INCHAR = 'c') OR
  1302.                (INCHAR = 'y') OR
  1303.                (INCHAR = 'A') OR
  1304.                (INCHAR = '0') OR
  1305.                (INCHAR = '1') OR
  1306.                (INCHAR = '.') OR
  1307.                (INCHAR = '!') OR
  1308.                (INCHAR = '+')) THEN
  1309.              CANEDIT := TRUE
  1310.            ELSE
  1311.              CANEDIT := FALSE;
  1312.          END;
  1313.  
  1314.  
  1315. BEGIN                           
  1316.   INSTRING := PAD(INSTRING,LENGTH(MASK));
  1317.   OLDVAL := INSTRING;
  1318.   INSON := FALSE;
  1319.   SAVECH := #0;
  1320.   CAPWO := FALSE;
  1321.   EDITALL := TRUE;
  1322.   OLDCUR := CUR;
  1323.   TEXTATTR := UT.INPUT_ATTR;
  1324.   LEN := LENGTH(INSTRING);
  1325.   FOR I := 1 TO LENGTH(INSTRING) DO
  1326.     BEGIN
  1327.       IF MASK[I] = 'c' THEN
  1328.         CAPWO := TRUE
  1329.       ELSE
  1330.         IF (NOT CANEDIT(MASK[I])) THEN
  1331.           BEGIN
  1332.             IF MASK[I] <> 'x' THEN
  1333.               INSTRING[I] := MASK[I];
  1334.             EDITALL := FALSE;
  1335.           END;
  1336.       IF EDITALL THEN
  1337.         BEGIN
  1338.           IF (POS('y',MASK) > 0) AND (MASK <> DUP('y',LENGTH(MASK))) THEN
  1339.             EDITALL := FALSE;
  1340.           IF (POS('y',MASK) > 0) AND (MASK <> DUP('y',LENGTH(MASK))) THEN
  1341.             EDITALL := FALSE;
  1342.           IF (POS('A',MASK) > 0) AND (MASK <> DUP('A',LENGTH(MASK))) THEN
  1343.             EDITALL := FALSE;
  1344.           IF (POS('0',MASK) > 0) AND (MASK <> DUP('0',LENGTH(MASK))) THEN
  1345.             EDITALL := FALSE;
  1346.           IF (POS('1',MASK) > 0) AND (MASK <> DUP('1',LENGTH(MASK))) THEN
  1347.             EDITALL := FALSE;
  1348.           IF (POS('.',MASK) > 0) AND (MASK <> DUP('.',LENGTH(MASK))) THEN
  1349.             EDITALL := FALSE;
  1350.           IF (POS('!',MASK) > 0) AND (MASK <> DUP('!',LENGTH(MASK))) THEN
  1351.             EDITALL := FALSE;
  1352.           IF (POS('+',MASK) > 0) AND (MASK <> DUP('+',LENGTH(MASK))) THEN
  1353.             EDITALL := FALSE;
  1354.         END;
  1355.     END;
  1356.   IF X > 99 THEN
  1357.     BEGIN
  1358.       X := X - 100;
  1359.       START := X;
  1360.       X := LEN;
  1361.       WHILE (X > 2) AND (NOT CANEDIT(MASK[X])) DO
  1362.         X := X - 1;
  1363.     END
  1364.   ELSE
  1365.     BEGIN
  1366.       START := X;
  1367.       X := X_IN;
  1368.     END;
  1369.   OLDATTR := SCREEN_ATTR(START,Y);
  1370.   GOTOXY(START,Y);
  1371.   WRITE(INSTRING);
  1372.   SET_CURSOR(UNDERLINE);
  1373.   WHILE (NOT CANEDIT(MASK[X])) AND (X <= LEN) DO
  1374.     X := X + 1;
  1375.   REPEAT
  1376.     GOTOXY(START+X-1,Y);
  1377.     READCH(CH,FALSE);
  1378.     CASE CH OF
  1379.         HOMEKEY : BEGIN
  1380.                     X := 1;
  1381.                     WHILE (NOT CANEDIT(MASK[X])) AND
  1382.                           (X <= LEN + START) DO
  1383.                       X := SUCC(X);
  1384.                   END;
  1385.          ENDKEY : BEGIN
  1386.                     X := LEN;
  1387.                     WHILE (X > 2) AND (INSTRING[X-1] = ' ') DO
  1388.                       X := PRED(X);
  1389.                     WHILE (NOT CANEDIT(MASK[X])) AND
  1390.                           (X <= LEN) DO
  1391.                       X := SUCC(X);
  1392.                     WHILE NOT CANEDIT(MASK[X]) DO
  1393.                       X := PRED(X);
  1394.                     IF X < 1 THEN
  1395.                       X := 1
  1396.                     ELSE
  1397.                       IF (X = 2) AND (INSTRING[1] = ' ') AND
  1398.                          (CANEDIT(MASK[1])) THEN
  1399.                         X := 1;
  1400.                   END;
  1401.              #8 : IF (X > 1) AND EDITALL THEN
  1402.                     BEGIN
  1403.                       DELETE(INSTRING,X-1,1);
  1404.                       INSTRING := INSTRING + ' ';
  1405.                       GOTOXY(START,Y);
  1406.                       WRITE(INSTRING);
  1407.                       X := PRED(X);
  1408.                       WHILE (NOT CANEDIT(MASK[X])) AND
  1409.                             (X > 1) DO
  1410.                         X := PRED(X);
  1411.                       WHILE NOT CANEDIT(MASK[X]) DO
  1412.                         X := SUCC(X);
  1413.                     END
  1414.                   ELSE
  1415.                     IF X > 1 THEN
  1416.                       BEGIN
  1417.                         X := PRED(X);
  1418.                         WHILE (NOT CANEDIT(MASK[X])) AND
  1419.                               (X > 1) DO
  1420.                           X := PRED(X);
  1421.                         WHILE NOT CANEDIT(MASK[X]) DO
  1422.                           X := SUCC(X);
  1423.                       END
  1424.                     ELSE
  1425.                       BEGIN
  1426.                         IF UT.NOCONV THEN
  1427.                           SAVECH := LEFT
  1428.                         ELSE
  1429.                           CH := UP;
  1430.                       END;
  1431.           RIGHT : IF X < LEN THEN
  1432.                     BEGIN
  1433.                       X := SUCC(X);
  1434.                       WHILE (NOT CANEDIT(MASK[X])) AND
  1435.                             (X <= LEN + START) DO
  1436.                         X := SUCC(X);
  1437.                       IF NOT CANEDIT(MASK[X]) THEN
  1438.                         IF UT.NOCONV THEN
  1439.                           SAVECH := RIGHT
  1440.                         ELSE
  1441.                           CH := DOWN;
  1442.                       WHILE NOT CANEDIT(MASK[X]) DO
  1443.                         X := PRED(X);
  1444.                     END
  1445.                   ELSE
  1446.                     BEGIN
  1447.                       IF UT.NOCONV THEN
  1448.                         SAVECH := CH
  1449.                       ELSE
  1450.                         CH := DOWN;
  1451.                     END;
  1452.            LEFT : IF X > 1 THEN
  1453.                     BEGIN
  1454.                       X := PRED(X);
  1455.                       WHILE (NOT CANEDIT(MASK[X])) AND
  1456.                             (X > 1) DO
  1457.                         X := PRED(X);
  1458.                       IF NOT CANEDIT(MASK[X]) THEN
  1459.                         IF UT.NOCONV THEN
  1460.                           SAVECH := LEFT
  1461.                         ELSE
  1462.                           CH := UP;
  1463.                       WHILE NOT CANEDIT(MASK[X]) DO
  1464.                         X := SUCC(X);
  1465.                     END
  1466.                   ELSE
  1467.                     BEGIN
  1468.                       IF UT.NOCONV THEN
  1469.                         SAVECH := LEFT
  1470.                       ELSE
  1471.                         CH := UP;
  1472.                     END;
  1473.        ' '..'~' : BEGIN
  1474.                     VALID := FALSE;
  1475.                     CASE MASK[X] OF
  1476.                         ' ',
  1477.                         'c'  : VALID := TRUE;
  1478.                         'A'  : BEGIN
  1479.                                  VALID := TRUE;
  1480.                                  CH := UPCASE(CH);
  1481.                                END;
  1482.                         'y'  : BEGIN
  1483.                                  CH := UPCASE(CH);
  1484.                                  IF CH IN ['Y','N'] THEN
  1485.                                    VALID := TRUE;
  1486.                                END;
  1487.                         '0'  : IF CH IN ['0'..'9'] THEN
  1488.                                  VALID := TRUE;
  1489.                         '1'  : IF CH IN ['0'..'9',' '] THEN
  1490.                                  VALID := TRUE;
  1491.                         '.'  : IF CH IN ['0'..'9','.'] THEN
  1492.                                  VALID := TRUE;
  1493.                         '!'  : IF CH IN ['0'..'9','.',' '] THEN
  1494.                                  VALID := TRUE;
  1495.                         '+'  : IF CH IN ['0'..'9','.',' ','+','-'] THEN
  1496.                                  VALID := TRUE;
  1497.                     END;
  1498.                     IF VALID THEN
  1499.                       BEGIN
  1500.                         IF (CAPWO) AND ((X = 1) OR
  1501.                            (INSTRING[X-1] = ' ')) THEN
  1502.                           CH := UPCASE(CH);
  1503.                         IF INSON THEN
  1504.                           BEGIN
  1505.                             DELETE(INSTRING,LENGTH(INSTRING),1);
  1506.                             INSERT(CH,INSTRING,X);
  1507.                             GOTOXY(START,Y);
  1508.                             WRITE(INSTRING);
  1509.                           END
  1510.                         ELSE
  1511.                           BEGIN
  1512.                             INSTRING[X] := CH;
  1513.                             GOTOXY(START+X-1,Y);
  1514.                             WRITE(CH);
  1515.                           END;
  1516.                         X := SUCC(X);
  1517.                         IF X > LEN THEN
  1518.                           BEGIN
  1519.                             IF UT.NOCONV THEN
  1520.                               SAVECH := RIGHT
  1521.                             ELSE
  1522.                               CH := DOWN;
  1523.                           END
  1524.                         ELSE
  1525.                           BEGIN
  1526.                             WHILE (NOT CANEDIT(MASK[X])) AND
  1527.                                   (X <= LEN + START) DO
  1528.                               X := SUCC(X);
  1529.                             IF NOT CANEDIT(MASK[X]) THEN
  1530.                               IF UT.NOCONV THEN
  1531.                                 SAVECH := RIGHT
  1532.                               ELSE
  1533.                                 CH := DOWN;
  1534.                             WHILE NOT CANEDIT(MASK[X]) DO
  1535.                               X := PRED(X);
  1536.                           END;
  1537.                       END;
  1538.                   END;
  1539.          INSKEY : BEGIN
  1540.                     INSON := NOT INSON;
  1541.                     IF INSON AND (EDITALL) THEN
  1542.                       SET_CURSOR(BLOCK)
  1543.                     ELSE
  1544.                       BEGIN
  1545.                         SET_CURSOR(UNDERLINE);
  1546.                         INSON := FALSE;
  1547.                       END;
  1548.                   END;
  1549.          DELKEY : IF EDITALL THEN
  1550.                     BEGIN
  1551.                       DELETE(INSTRING,X,1);
  1552.                       INSTRING := INSTRING + ' ';
  1553.                       GOTOXY(START,Y);
  1554.                       WRITE(INSTRING);
  1555.                     END;
  1556.           ALT_C : BEGIN
  1557.                     FOR I := 1 TO LEN DO
  1558.                       IF CANEDIT(MASK[I]) THEN
  1559.                         INSTRING[I] := ' ';
  1560.                     X := 1;
  1561.                     GOTOXY(START,Y);
  1562.                     WRITE(INSTRING);
  1563.                     WHILE (NOT CANEDIT(MASK[X])) AND
  1564.                           (X <= LEN) DO
  1565.                       X := SUCC(X);
  1566.                   END;
  1567.     END;
  1568.     IF X > LEN THEN X := LEN;
  1569.   UNTIL (CH = #27) OR (UT.EXITCH[ORD(CH)]) OR (SAVECH <> #0);
  1570.   IF SAVECH <> #0 THEN
  1571.     CH := SAVECH;
  1572.   X_OUT := X;
  1573.   X_IN  := 1;
  1574.   SET_CURSOR(UNDERLINE);
  1575.   TEXTATTR := OLDATTR;
  1576.   GOTOXY(START,Y);
  1577.   WRITE(INSTRING);
  1578.   TEXTATTR := UT.DEFAULT_ATTR;
  1579.   SET_CURSOR(OLDCUR);
  1580.   CHANGED := INSTRING <> OLDVAL;
  1581. END;
  1582.  
  1583. PROCEDURE READ_ONLY(NAME : STRING);
  1584. VAR
  1585.   F    : FILE;
  1586.   ATTR : WORD;
  1587. BEGIN
  1588.   ASSIGN(F,NAME);
  1589.   GETFATTR(F,ATTR);
  1590.   ATTR := ATTR OR 1;
  1591.   SETFATTR(F,ATTR);
  1592. END;
  1593.  
  1594. PROCEDURE READ_WRITE(NAME : STRING);
  1595. VAR
  1596.   F    : FILE;
  1597.   ATTR : WORD;
  1598. BEGIN
  1599.   ASSIGN(F,NAME);
  1600.   GETFATTR(F,ATTR);
  1601.   IF ODD(ATTR) THEN
  1602.     ATTR := ATTR - 1;
  1603.   SETFATTR(F,ATTR);
  1604. END;
  1605.  
  1606. PROCEDURE READ_REAL(X,Y,LEN  : INTEGER;
  1607.                     PATTR    : INTEGER;
  1608.                     PROMPT   : STR80;
  1609.                     IATTR    : INTEGER;
  1610.                     VAR R    : REAL;
  1611.                     DPLACES  : INTEGER;
  1612.                     LOW,HIGH : REAL;
  1613.                     EXITCH   : ETYPE;
  1614.                     ICOMA    : BOOLEAN;
  1615.                     TX, TY   : INTEGER;
  1616.                     CH       : CHAR);
  1617. VAR
  1618.   RESULT : INTEGER;
  1619.   TEMP   : STRING[40];
  1620.   T      : ETYPE;
  1621.   S      : BUF160;
  1622.   SAT    : INTEGER;
  1623. BEGIN
  1624.   IF ICOMA THEN
  1625.     TEMP := COMMA(R,0,DPLACES,RNUM)
  1626.   ELSE
  1627.     STR(R:0:DPLACES,TEMP);
  1628.   IF (R = 0.0) OR (CLEAR IN EXITCH) THEN
  1629.     BEGIN
  1630.       TEMP := '0';
  1631.       TEMP := PAD(TEMP,LEN);
  1632.       EXITCH := EXITCH - [CLEAR];
  1633.     END;
  1634.   T := [' ','0'..'9','-',','];
  1635.   IF DPLACES > 0 THEN
  1636.     T := T + ['.'];
  1637.   REPEAT
  1638.     WHILE LENGTH(TEMP) < LEN DO
  1639.       TEMP := TEMP + ' ';
  1640.     READSTR(X,Y,LEN,PATTR,PROMPT,IATTR,TEMP,T,[1..LEN],EXITCH,TX,TY,CH);
  1641.     WHILE (TEMP[1] = ' ') AND (LENGTH(TEMP) > 0) DO
  1642.       DELETE(TEMP,1,1);
  1643.     WHILE (TEMP[LENGTH(TEMP)] = ' ') AND (LENGTH(TEMP) > 0) DO
  1644.       DELETE(TEMP,LENGTH(TEMP),1);
  1645.     IF TEMP[LENGTH(TEMP)] = '.' THEN
  1646.       DELETE(TEMP,LENGTH(TEMP),1);
  1647.     WHILE (POS(',',TEMP) > 0) AND (LENGTH(TEMP) > 0) DO
  1648.       DELETE(TEMP,POS(',',TEMP),1);
  1649.     IF TEMP[1] = '.' THEN
  1650.       TEMP := '0' + TEMP;
  1651.     VAL(TEMP,R,RESULT);
  1652.     IF (RESULT = 0) AND ((R < LOW) OR (R > HIGH)) THEN
  1653.       RESULT := 1;
  1654.     IF RESULT <> 0 THEN
  1655.       BEGIN
  1656.         SAT := TEXTATTR;
  1657.         SAVE_LINE(Y+1,S);
  1658.         TEXTATTR := $4F;
  1659.         IF X > 30 THEN
  1660.           GOTOXY(30,Y+1)
  1661.         ELSE
  1662.           GOTOXY(X,Y+1);
  1663.         WRITE(' Range: ',LOW:0:DPLACES,' to ',HIGH:0:DPLACES,'  Press <any key> ',CHR(8));
  1664.         READCH(CH,FALSE);
  1665.         REBUILD_LINE(Y+1,S);
  1666.         TEXTATTR := SAT;
  1667.       END;
  1668.   UNTIL RESULT = 0;
  1669.   WHILE LENGTH(TEMP) < LEN DO
  1670.     TEMP := ' ' + TEMP;
  1671.   IF ICOMA THEN
  1672.     FW(X+LENGTH(PROMPT),Y,IATTR,COMMA(R,LEN,DPLACES,RNUM))
  1673.   ELSE
  1674.     FW(X+LENGTH(PROMPT),Y,IATTR,TEMP);
  1675. END;
  1676.  
  1677. PROCEDURE READ_INT(X,Y,LEN   : INTEGER;
  1678.                     PATTR    : INTEGER;
  1679.                     PROMPT   : STR80;
  1680.                     IATTR    : INTEGER;
  1681.                     VAR R    : INTEGER;
  1682.                     LOW,HIGH : INTEGER;
  1683.                     EXITCH   : ETYPE;
  1684.                     ICOMA    : BOOLEAN;
  1685.                     TX, TY   : INTEGER;
  1686.                     CH       : CHAR);
  1687. VAR
  1688.   RESULT : INTEGER;
  1689.   TEMP   : STRING;
  1690.   T      : ETYPE;
  1691.   S      : BUF160;
  1692.   SAT    : INTEGER;
  1693. BEGIN
  1694.   IF (R = 0) OR (CLEAR IN EXITCH) THEN
  1695.     BEGIN
  1696.       TEMP := '0';
  1697.       EXITCH := EXITCH - [CLEAR];
  1698.     END
  1699.   ELSE
  1700.     IF ICOMA THEN
  1701.       TEMP := COMMA(R,0,0,INUM)
  1702.     ELSE
  1703.       STR(R,TEMP);
  1704.   WHILE LENGTH(TEMP) < LEN DO
  1705.     TEMP := TEMP + ' ';
  1706.   T := [' ','0'..'9','-',','];
  1707.   REPEAT
  1708.     WHILE LENGTH(TEMP) < LEN DO
  1709.       TEMP := TEMP + ' ';
  1710.     READSTR(X,Y,LEN,PATTR,PROMPT,IATTR,TEMP,T,[1..LEN],EXITCH,TX,TY,CH);
  1711.     WHILE (TEMP[1] = ' ') AND (LENGTH(TEMP) > 0) DO
  1712.       DELETE(TEMP,1,1);
  1713.     WHILE (TEMP[LENGTH(TEMP)] = ' ') AND (LENGTH(TEMP) > 0) DO
  1714.       DELETE(TEMP,LENGTH(TEMP),1);
  1715.     WHILE (POS(',',TEMP) > 0) AND (LENGTH(TEMP) > 0) DO
  1716.       DELETE(TEMP,POS(',',TEMP),1);
  1717.     IF _LONGINT(TEMP) <= 32767 THEN
  1718.       VAL(TEMP,R,RESULT)
  1719.     ELSE
  1720.       RESULT := 1;
  1721.     IF (RESULT = 0) AND ((R < LOW) OR (R > HIGH)) THEN
  1722.       RESULT := 1;
  1723.     IF RESULT <> 0 THEN
  1724.       BEGIN
  1725.         SAVE_LINE(Y+1,S);
  1726.         SAT := TEXTATTR;
  1727.         TEXTATTR := $4F;
  1728.         IF X > 39 THEN
  1729.           GOTOXY(39,Y+1)
  1730.         ELSE
  1731.           GOTOXY(X,Y+1);
  1732.         WRITE(' Range: ',LOW,' to ',HIGH,'  Press <any key> ',CHR(8));
  1733.         READCH(CH,FALSE);
  1734.         REBUILD_LINE(Y+1,S);
  1735.         TEXTATTR := SAT;
  1736.       END;
  1737.   UNTIL RESULT = 0;
  1738.   WHILE LENGTH(TEMP) < LEN DO
  1739.     TEMP := ' ' + TEMP;
  1740.   IF ICOMA THEN
  1741.     FW(X+LENGTH(PROMPT),Y,IATTR,COMMA(R,LEN,0,INUM))
  1742.   ELSE
  1743.     FW(X+LENGTH(PROMPT),Y,IATTR,TEMP);
  1744. END;
  1745.  
  1746. FUNCTION DRIVE_READY(DRIVE : CHAR) : BOOLEAN;
  1747. BEGIN
  1748.   DRIVE_READY := DISKSIZE(ORD(DRIVE)-64) <> -1;
  1749. END;
  1750.  
  1751. FUNCTION _REAL(INSTRING : STRING) : REAL;
  1752. VAR
  1753.   R      : REAL;
  1754.   RESULT : INTEGER;
  1755. BEGIN
  1756.   WHILE POS(' ',INSTRING) > 0 DO
  1757.     DELETE(INSTRING,POS(' ',INSTRING),1);
  1758.   VAL(INSTRING,R,RESULT);
  1759.   _REAL := R;
  1760. END;
  1761.  
  1762. FUNCTION _INTEGER(INSTRING : STRING) : INTEGER;
  1763. VAR
  1764.   I,
  1765.   RESULT : INTEGER;
  1766. BEGIN
  1767.   WHILE POS(' ',INSTRING) > 0 DO
  1768.     DELETE(INSTRING,POS(' ',INSTRING),1);
  1769.   IF POS('.',INSTRING) > 0 THEN
  1770.     INSTRING := COPY(INSTRING,1,POS('.',INSTRING)-1);
  1771.   IF (LENGTH(INSTRING) >= 5) AND (INSTRING > '32767') THEN
  1772.     BEGIN
  1773.       _INTEGER := 0;
  1774.       EXIT;
  1775.     END;
  1776.   VAL(INSTRING,I,RESULT);
  1777.   _INTEGER := I;
  1778. END;
  1779.  
  1780. FUNCTION _LONGINT(INSTRING : STRING) : LONGINT;
  1781. VAR
  1782.   SIGN,
  1783.   LEN,
  1784.   I      : INTEGER;
  1785.   TENS,
  1786.   NUMBER : LONGINT;
  1787. BEGIN
  1788.   TENS := 1;
  1789.   NUMBER := 0;
  1790.   SIGN := 1;
  1791.   _LONGINT := 0;
  1792.   WHILE POS(' ',INSTRING) > 0 DO
  1793.     DELETE(INSTRING,POS(' ',INSTRING),1);
  1794.   IF POS('.',INSTRING) > 0 THEN
  1795.     INSTRING := COPY(INSTRING,1,POS('.',INSTRING)-1);
  1796.   IF (LENGTH(INSTRING) >= 10) AND (INSTRING > '2147483648') THEN
  1797.     EXIT;
  1798.   LEN := LENGTH(INSTRING);
  1799.   IF INSTRING[1] = '-' THEN
  1800.     BEGIN
  1801.       IF LEN = 1 THEN
  1802.         EXIT;
  1803.       SIGN := -1;
  1804.     END;
  1805.   FOR I := LEN DOWNTO 1 DO
  1806.     IF (INSTRING[I] < '0') OR (INSTRING[I] > '9') THEN
  1807.     ELSE
  1808.       BEGIN
  1809.         NUMBER := NUMBER + (ORD(INSTRING[I]) - ORD('0')) * TENS;
  1810.         TENS := TENS * 10;
  1811.       END;
  1812.   NUMBER := NUMBER * SIGN;
  1813.   _LONGINT := NUMBER;
  1814. END;
  1815.  
  1816. FUNCTION _WORD(INSTRING : STRING) : WORD;
  1817. VAR
  1818.   SIGN,
  1819.   LEN,
  1820.   I      : INTEGER;
  1821.   TENS   : LONGINT;
  1822.   NUMBER : WORD;
  1823. BEGIN
  1824.   TENS := 1;
  1825.   NUMBER := 0;
  1826.   SIGN := 1;
  1827.   _WORD := 0;
  1828.   WHILE POS(' ',INSTRING) > 0 DO
  1829.     DELETE(INSTRING,POS(' ',INSTRING),1);
  1830.   IF POS('.',INSTRING) > 0 THEN
  1831.     INSTRING := COPY(INSTRING,1,POS('.',INSTRING)-1);
  1832.   IF (LENGTH(INSTRING) >= 5) AND (INSTRING > '65535') THEN
  1833.     EXIT;
  1834.   LEN := LENGTH(INSTRING);
  1835.   IF INSTRING[1] = '-' THEN
  1836.     BEGIN
  1837.       IF LEN = 1 THEN
  1838.         EXIT;
  1839.       SIGN := -1;
  1840.     END;
  1841.   FOR I := LEN DOWNTO 1 DO
  1842.     IF (INSTRING[I] < '0') OR (INSTRING[I] > '9') THEN
  1843.       EXIT
  1844.     ELSE
  1845.       BEGIN
  1846.         NUMBER := NUMBER + (ORD(INSTRING[I]) - ORD('0')) * TENS;
  1847.         TENS := TENS * 10;
  1848.       END;
  1849.   NUMBER := NUMBER * SIGN;
  1850.   _WORD := NUMBER;
  1851. END;
  1852.  
  1853. FUNCTION GET_FILE_NAME(MASK : STRING; DEL : BOOLEAN) : STRING;
  1854. TYPE
  1855.   STR12     = STRING[12];
  1856. VAR
  1857.   I,J,
  1858.   FM,
  1859.   TOP,
  1860.   SEL,
  1861.   INDEX     : INTEGER;
  1862.   TEMP      : STR12;
  1863.   DIRINFO   : SEARCHREC;
  1864.   SAVENAME  : ARRAY [1..500] OF STRING[12];
  1865.   F         : FILE;
  1866.   C         : CURTYPE;
  1867.   SAVE_ATTR : INTEGER;
  1868.  
  1869.       PROCEDURE WRITE_PAGE;
  1870.       VAR
  1871.         I : INTEGER;
  1872.       BEGIN
  1873.         J := 10;
  1874.         WINDOW(36,10,50,17);
  1875.         CLRSCR;
  1876.         WINDOW(1,1,80,25);
  1877.         FOR I := TOP TO TOP+7 DO
  1878.           IF I <= INDEX THEN
  1879.             BEGIN
  1880.               FW(38,J,$0E,SAVENAME[I]);
  1881.               J := SUCC(J);
  1882.             END;
  1883.       END;
  1884.  
  1885. BEGIN
  1886.   C := CUR;
  1887.   SAVE_ATTR := TEXTATTR;
  1888.   SET_CURSOR(NONE);
  1889.   TEXTBACKGROUND(BLACK);
  1890.   FM := FILEMODE;
  1891.   FILEMODE := 0;
  1892.   INDEX := 1;
  1893.   FILLCHAR(SAVENAME,SIZEOF(SAVENAME),0);
  1894.   FINDFIRST(MASK,READONLY+ARCHIVE,DIRINFO);
  1895.   WHILE DOSERROR = 0 DO
  1896.     BEGIN
  1897.       SAVENAME[INDEX] := DIRINFO.NAME;
  1898.       INDEX := SUCC(INDEX);
  1899.       FINDNEXT(DIRINFO);
  1900.     END;
  1901.   INDEX := PRED(INDEX);
  1902.   FOR I := 1 TO INDEX DO
  1903.     FOR J := I+1 TO INDEX DO
  1904.       IF SAVENAME[I] > SAVENAME[J] THEN
  1905.         BEGIN
  1906.           TEMP := SAVENAME[I];
  1907.           SAVENAME[I] := SAVENAME[J];
  1908.           SAVENAME[J] := TEMP;
  1909.         END;
  1910.   FW(35, 8,$0E,'╔═ Select File ═╗');
  1911.   FW(35, 9,$0E,'║               ║');
  1912.   FW(35,10,$0E,'║               ║');
  1913.   FW(35,11,$0E,'║               ║');
  1914.   FW(35,12,$0E,'║               ║');
  1915.   FW(35,13,$0E,'║               ║');
  1916.   FW(35,14,$0E,'║               ║');
  1917.   FW(35,15,$0E,'║               ║');
  1918.   FW(35,16,$0E,'║               ║');
  1919.   FW(35,17,$0E,'║               ║');
  1920.   FW(35,18,$0E,'║               ║');
  1921.   FW(35,19,$0E,'║               ║');
  1922.   FW(35,20,$0E,'║               ║');
  1923.   FW(35,21,$0E,'╚═══════════════╝');
  1924.   FW(39,19,$0F,CHR(24)+' '+CHR(25)+'   '+ENTER_KEY);
  1925.   FW(38,20,$0F,'PgUp   PgDn');
  1926.   IF DEL THEN
  1927.     BEGIN
  1928.       FW(35,21,$0E,'║  <DEL> Delete ║');
  1929.       FW(35,22,$0E,'╚═══════════════╝');
  1930.       SET_ATTR([36..49],21,$0F);
  1931.     END;
  1932.   SET_CURSOR(NONE);
  1933.   TOP := 1;
  1934.   SEL := 1;
  1935.   FOR I := 1 TO 8 DO
  1936.     IF I <= INDEX THEN
  1937.       FW(38,I+9,$0E,SAVENAME[I]);
  1938.   REPEAT
  1939.     SET_ATTR([37..49],SEL+9,$70);
  1940.     READCH(CH,FALSE);
  1941.     CH := UPCASE(CH);
  1942.     SET_ATTR([37..49],SEL+9,$0E);
  1943.     CASE CH OF
  1944.        '0'..'9',
  1945.        'A'..'Z' : BEGIN
  1946.                     TOP := 1;
  1947.                     WHILE (TOP < 500) AND (SAVENAME[TOP][1] < CH) DO
  1948.                       TOP := SUCC(TOP);
  1949.                     SEL := 1;
  1950.                     WHILE (TOP > 1) AND (LENGTH(SAVENAME[TOP]) = 0) DO
  1951.                       TOP := PRED(TOP);
  1952.                     WRITE_PAGE;
  1953.                   END;
  1954.              UP : IF SEL > 1 THEN
  1955.                     SEL := PRED(SEL)
  1956.                   ELSE
  1957.                     IF TOP > 1 THEN
  1958.                       BEGIN
  1959.                         WINDOW(36,10,50,17);
  1960.                         INSLINE;
  1961.                         WINDOW(1,1,80,25);
  1962.                         TOP := PRED(TOP);
  1963.                         FW(38,10,$0E,SAVENAME[TOP]);
  1964.                       END;
  1965.            DOWN : IF (SEL < 8) AND (TOP+SEL-1 < INDEX) THEN
  1966.                     SEL := SUCC(SEL)
  1967.                   ELSE
  1968.                     IF TOP+SEL < INDEX THEN
  1969.                       BEGIN
  1970.                         WINDOW(36,10,50,17);
  1971.                         GOTOXY(1,8);
  1972.                         WRITELN;
  1973.                         WINDOW(1,1,80,25);
  1974.                         TOP := SUCC(TOP);
  1975.                         FW(38,17,$0E,SAVENAME[TOP+SEL-1]);
  1976.                       END;
  1977.            PGDN : IF TOP + 8 <= INDEX THEN
  1978.                     BEGIN
  1979.                       SEL := 1;
  1980.                       TOP := TOP + 8;
  1981.                       WRITE_PAGE;
  1982.                     END;
  1983.            PGUP : IF TOP > 1 THEN
  1984.                     BEGIN
  1985.                       SEL := 1;
  1986.                       TOP := TOP - 8;
  1987.                       IF TOP < 1 THEN TOP := 1;
  1988.                       WRITE_PAGE;
  1989.                     END;
  1990.          DELKEY : IF DEL THEN
  1991.                     BEGIN
  1992.                       SET_ATTR([37..49],SEL+9,$70);
  1993.                       FW(36,21,$8E,' Are You Sure? ');
  1994.                       SET_CURSOR(UNDERLINE);
  1995.                       REPEAT
  1996.                         GOTOXY(50,21);
  1997.                         READCH(CH,FALSE);
  1998.                         CH := UPCASE(CH);
  1999.                       UNTIL CH IN ['Y','N'];
  2000.                       SET_CURSOR(NONE);
  2001.                       IF CH = 'Y' THEN
  2002.                         BEGIN
  2003.                           ASSIGN(F,SAVENAME[TOP+SEL-1]);
  2004.                           {$I-}
  2005.                             ERASE(F);
  2006.                           {$I+}
  2007.                           IF IORESULT = 0 THEN
  2008.                             BEGIN
  2009.                               FOR I := TOP+SEL-1 TO INDEX-1 DO
  2010.                                 SAVENAME[I] := SAVENAME[I+1];
  2011.                               INDEX := PRED(INDEX);
  2012.                               WRITE_PAGE;
  2013.                             END;
  2014.                         END;
  2015.                       FW(37,21,$0F,' <DEL> Delete ');
  2016.                     END;
  2017.     END;
  2018.   UNTIL (CH = RETURN) OR (CH = ESCAPE);
  2019.   IF CH = RETURN THEN
  2020.     GET_FILE_NAME := SAVENAME[TOP+SEL-1]
  2021.   ELSE
  2022.     GET_FILE_NAME := '';
  2023.   CH := 'X';
  2024.   SET_CURSOR(CUR);
  2025.   FILEMODE := FM;
  2026.   TEXTATTR := SAVE_ATTR;
  2027. END;
  2028.  
  2029. PROCEDURE PATHEXEC(COMMAND : PATHSTR; PARMS : STRING);
  2030. VAR
  2031.   P,
  2032.   DIRSTR    : STRING;
  2033.   AllocError: Integer;
  2034.   Regs      : Registers;
  2035.  
  2036. BEGIN
  2037.   DIRSTR := GETENV('PATH');
  2038.   P := FSEARCH(COMMAND,DIRSTR);
  2039.   IF P <> '' THEN
  2040.     BEGIN
  2041.       SWAPVECTORS;
  2042.       EXEC(P,PARMS);
  2043.       SWAPVECTORS;
  2044.     END
  2045.   ELSE
  2046.     DOSERROR := 2;
  2047. END;
  2048.  
  2049. FUNCTION  COMMA(VAR VALUE; FIELDWIDTH, PLACES : INTEGER; NTYPE : TYPEN) : STRING;
  2050. VAR
  2051.   TEMP           : STRING;
  2052.   I,
  2053.   COMMAPOS,
  2054.   COMMASINSERTED : INTEGER;
  2055.   RNUMBER        : REAL ABSOLUTE VALUE;
  2056.   LNUMBER        : LONGINT ABSOLUTE VALUE;
  2057.   INUMBER        : INTEGER ABSOLUTE VALUE;
  2058. BEGIN
  2059.   IF FIELDWIDTH < 0 THEN FIELDWIDTH := 0;
  2060.   IF PLACES < 0 THEN PLACES := 0;
  2061.   CASE NTYPE OF
  2062.       RNUM : STR(RNUMBER:FIELDWIDTH:PLACES,TEMP);
  2063.       LNUM : BEGIN
  2064.                STR(LNUMBER:FIELDWIDTH,TEMP);
  2065.                PLACES := 0;
  2066.              END;
  2067.       INUM : BEGIN
  2068.                STR(INUMBER:FIELDWIDTH,TEMP);
  2069.                PLACES := 0;
  2070.              END;
  2071.   END;
  2072.   IF PLACES = 0 THEN
  2073.     COMMAPOS := LENGTH(TEMP)-2
  2074.   ELSE
  2075.     COMMAPOS := LENGTH(TEMP)-PLACES-3;
  2076.   COMMASINSERTED := 0;
  2077.   WHILE (COMMAPOS > 1) AND (TEMP[COMMAPOS-1] IN ['0'..'9']) DO
  2078.     BEGIN
  2079.       INSERT(',',TEMP,COMMAPOS);
  2080.       COMMASINSERTED := SUCC(COMMASINSERTED);
  2081.       COMMAPOS := COMMAPOS - 3;
  2082.     END;
  2083.   FOR I := 1 TO COMMASINSERTED DO
  2084.     IF TEMP[1] = ' ' THEN
  2085.       DELETE(TEMP,1,1);
  2086.   COMMA := TEMP;
  2087. END;
  2088.  
  2089. FUNCTION READ_SCREEN(X,Y : INTEGER) : CHAR;
  2090. VAR
  2091.   Z : INTEGER;
  2092. BEGIN
  2093.   Z := (((Y * 160) - 160) + (X * 2)) - 1;
  2094.   READ_SCREEN := P^[Z];
  2095. END;
  2096.  
  2097. FUNCTION SCREEN_ATTR(X,Y : INTEGER) : BYTE;
  2098. VAR
  2099.   Z : INTEGER;
  2100. BEGIN
  2101.   Z := (((Y * 160) - 160) + (X * 2));
  2102.   SCREEN_ATTR := ORD(P^[Z]);
  2103. END;
  2104.  
  2105. PROCEDURE READCHT(VAR CH : CHAR; ECHO : BOOLEAN; TOO : LONGINT);
  2106. VAR
  2107.   T      : LONGINT;
  2108.   HELP   : BOOLEAN;
  2109.   ATX,
  2110.   ATY    : INTEGER;
  2111.   LINE25 : BUF160;
  2112. BEGIN
  2113.   ATX := WHEREX;
  2114.   ATY := WHEREY;
  2115.   START_TIMER(T);
  2116.   HELP := FALSE;
  2117.   SAVE_LINE(25,LINE25);
  2118.   REPEAT
  2119.     IF (SHIFT_KEYS('A')) AND (HELP_LINE <> '') THEN
  2120.       BEGIN
  2121.         FW(1,25,HELP_ATTR,PAD(HELP_LINE,80));
  2122.         GOTOXY(ATX,ATY);
  2123.         HELP := TRUE;
  2124.       END
  2125.     ELSE
  2126.       IF (SHIFT_KEYS('C')) AND (HELP_LINE2 <> '') THEN
  2127.         BEGIN
  2128.           FW(1,25,HELP_ATTR2,PAD(HELP_LINE2,80));
  2129.           GOTOXY(ATX,ATY);
  2130.           HELP := TRUE;
  2131.         END
  2132.       ELSE
  2133.         IF HELP THEN
  2134.           BEGIN
  2135.             REBUILD_LINE(25,LINE25);
  2136.             GOTOXY(ATX,ATY);
  2137.             HELP := FALSE;
  2138.           END;
  2139.   UNTIL KEYPRESSED OR (ELAP_TIME(T) >= TOO) OR (COMMAND_BUFFER <> '');
  2140.   REBUILD_LINE(25,LINE25);
  2141.   IF KEYPRESSED THEN
  2142.     READCH(CH,ECHO);
  2143. END;
  2144.  
  2145. PROCEDURE PRINT_SCREEN(X1,Y1,X2,Y2 : INTEGER; EXT : BOOLEAN);
  2146. VAR
  2147.   CH   : CHAR;
  2148.   I,J  : INTEGER;
  2149. BEGIN
  2150.   IF NOT PRINTER_READY THEN EXIT;
  2151.   FOR I := Y1 TO Y2 DO
  2152.     BEGIN
  2153.       FOR J := X1 TO X2 DO
  2154.         BEGIN
  2155.           CH := READ_SCREEN(J,I);
  2156.           IF (CH IN [' '..'~']) OR EXT THEN
  2157.             WRITE(LST,CH)
  2158.           ELSE
  2159.             WRITE(LST,' ');
  2160.         END;
  2161.       WRITELN(LST);
  2162.     END;
  2163. END;
  2164.  
  2165. FUNCTION PRINTER_READY : BOOLEAN;
  2166. VAR
  2167.   SC : BUFFER;
  2168. BEGIN
  2169.   IF PRINTER_NOT_READY THEN
  2170.     BEGIN
  2171.       SAVE_SCREEN(SC);
  2172.       POP_WINDOW(30,10,57,14,2,$4F);
  2173.       FW(34,11,$CF,'PRINTER NOT READY !!');
  2174.       FW(33,13,$4F,'Ready Printer, or <ESC>');
  2175.       CH := 'X';
  2176.       GOTOXY(56,13);
  2177.       WHILE (CH <> ESCAPE) AND PRINTER_NOT_READY DO
  2178.         IF KEYPRESSED THEN
  2179.           READCH(CH,FALSE);
  2180.       IF CH = ESCAPE THEN
  2181.         PRINTER_READY := FALSE
  2182.       ELSE
  2183.         PRINTER_READY := TRUE;
  2184.       CH := 'X';
  2185.       REBUILD_SCREEN(SC);
  2186.     END
  2187.   ELSE
  2188.     PRINTER_READY := TRUE;
  2189. END;
  2190.  
  2191. FUNCTION COMBINE(S1, S2 : STRING;
  2192.                     MAX : INTEGER;
  2193.            INSERT_COMMA : BOOLEAN) : STRING;
  2194. BEGIN
  2195.   WHILE (S1[LENGTH(S1)] = ' ') AND (LENGTH(S1) > 0) DO
  2196.     DELETE(S1,LENGTH(S1),1);
  2197.   IF INSERT_COMMA THEN
  2198.     S1 := S1 + ', ' + S2
  2199.   ELSE
  2200.     S1 := S1 + ' ' + S2;
  2201.   IF LENGTH(S1) > MAX THEN
  2202.     S1 := COPY(S1,1,MAX)
  2203.   ELSE
  2204.     WHILE LENGTH(S1) < MAX DO
  2205.       S1 := S1 + ' ';
  2206.   COMBINE := S1;
  2207. END;
  2208.  
  2209. PROCEDURE ENCRYPT(VAR LINE : STRING; I : INTEGER);
  2210. BEGIN
  2211.   RANDSEED := I;
  2212.   FOR I := 1 TO LENGTH(LINE) DO
  2213.     LINE[I] := CHR(ORD(LINE[I]) + RANDOM(10));
  2214. END;
  2215.  
  2216. PROCEDURE UN_ENCRYPT(VAR LINE : STRING; I : INTEGER);
  2217. BEGIN
  2218.   RANDSEED := I;
  2219.   FOR I := 1 TO LENGTH(LINE) DO
  2220.     LINE[I] := CHR(ORD(LINE[I]) - RANDOM(10));
  2221. END;
  2222.  
  2223. PROCEDURE CENTER(Y, ATTRIB : INTEGER; LINE : STRING);
  2224. VAR
  2225.   TEMP      : STRING;
  2226. BEGIN
  2227.   TEMP := STRIP(LINE,FALSE);
  2228.   FW(40 - (LENGTH(TEMP) DIV 2),Y,ATTRIB,TEMP);
  2229. END;
  2230.  
  2231. PROCEDURE SET_ATTR_BOX(X1,Y1,X2,Y2,ATT : INTEGER);
  2232. VAR
  2233.   I : INTEGER;
  2234. BEGIN
  2235.   FOR I := Y1 TO Y2 DO
  2236.     SET_ATTR([X1..X2],I,ATT);
  2237. END;
  2238.  
  2239. FUNCTION FILE_OPEN(VAR F) : BOOLEAN;
  2240. VAR
  2241.   FILE_INFO : FILEREC ABSOLUTE F;
  2242. BEGIN
  2243.   FILE_OPEN := FILE_INFO.MODE <> FMCLOSED;
  2244. END;
  2245.  
  2246. PROCEDURE WRITE_X80_Y25(CH : CHAR; ATTRIB : INTEGER);
  2247. BEGIN
  2248.   FW(80,25,ATTRIB,CH);
  2249. END;
  2250.  
  2251. PROCEDURE GET_DOS_VER;
  2252. VAR
  2253.   VER   : WORD;
  2254.   TEMP,
  2255.   TEMP2 : STRING[4];
  2256. BEGIN
  2257.   VER := DOSVERSION;
  2258.   STR(LO(VER),TEMP);
  2259.   STR(HI(VER),TEMP2);
  2260.   DOS_VER := TEMP + '.' + TEMP2;
  2261. END;
  2262.  
  2263. FUNCTION RANDOM_NUMBER(LOW, HIGH : INTEGER) : INTEGER;
  2264. VAR
  2265.   H,M,S,S100 : WORD;
  2266. BEGIN
  2267.   IF (LOW < 0) OR (HIGH > 99) THEN
  2268.     BEGIN
  2269.       RANDOM_NUMBER := 0;
  2270.       EXIT;
  2271.     END;
  2272.   REPEAT
  2273.     GETTIME(H,M,S,S100);
  2274.   UNTIL (S100 >= LOW) AND (S100 <= HIGH);
  2275.   RANDOM_NUMBER := S100;
  2276. END;
  2277.  
  2278. FUNCTION FILE_EXIST(FILENAME : STRING) : BOOLEAN;
  2279. VAR
  2280.   INF : SEARCHREC;
  2281. BEGIN
  2282.   FINDFIRST(FILENAME,ANYFILE-DIRECTORY,INF);
  2283.   FILE_EXIST := (DOSERROR = 0);
  2284. END;
  2285.  
  2286. PROCEDURE BEEP;
  2287. BEGIN
  2288.   SOUND(400);
  2289.   DELAY(150);
  2290.   SOUND(300);
  2291.   DELAY(100);
  2292.   NOSOUND;
  2293. END;
  2294.  
  2295. PROCEDURE READSTR_BIG(X,Y,LEN : INTEGER;
  2296.                         PATTR : INTEGER;
  2297.                        PROMPT : STR80;
  2298.                         IATTR : INTEGER;
  2299.                  VAR INSTRING : STRING;
  2300.                         VALID : ETYPE;
  2301.                       CANEDIT : CTYPE;
  2302.                        EXITCH : ETYPE;
  2303.                        XLOC,
  2304.                        YLOC   : INTEGER;
  2305.                        CH1    : CHAR;
  2306.                        WIN    : INTEGER);
  2307. VAR
  2308.   I,
  2309.   XX,
  2310.   START,
  2311.   OFS    : INTEGER;
  2312.   CAPIT,
  2313.   CAPWO,
  2314.   INSON  : BOOLEAN;
  2315.   SAVECH : CHAR;
  2316.   SX, SY : INTEGER;
  2317.  
  2318. BEGIN
  2319.   OLDVAL := INSTRING;
  2320.   INSON := FALSE;
  2321.   IF X_IN > LEN THEN
  2322.     X_IN := LEN;
  2323.   IF X_IN > WIN THEN
  2324.     OFS   := X_IN
  2325.   ELSE
  2326.     OFS   := 1;                
  2327.   IF OFS + WIN > LEN THEN
  2328.     OFS := LEN - WIN + 1;
  2329.   IF YLOC > 199 THEN
  2330.     BEGIN
  2331.       CAPIT := TRUE;
  2332.       YLOC := YLOC - 200;
  2333.     END
  2334.   ELSE
  2335.     BEGIN
  2336.       CAPIT := FALSE;
  2337.       IF YLOC > 99 THEN
  2338.         BEGIN
  2339.           YLOC := YLOC - 100;
  2340.           CAPWO := TRUE;
  2341.         END
  2342.       ELSE
  2343.         CAPWO := FALSE;
  2344.     END;
  2345.   IF CLEAR IN EXITCH THEN
  2346.     INSTRING := SPACES(LEN)
  2347.   ELSE
  2348.     INSTRING := PAD(INSTRING,LEN);
  2349.   FW(X,Y,PATTR,PROMPT);
  2350.   START := X + LENGTH(PROMPT);
  2351.   IF X_IN > WIN THEN
  2352.     X := X_IN - OFS + 1
  2353.   ELSE
  2354.     X := X_IN;
  2355.   FW(START,Y,IATTR,COPY(INSTRING,OFS,WIN));
  2356.   IF XLOC > 99 THEN
  2357.     BEGIN
  2358.       X := LEN;
  2359.       XLOC := XLOC - 100;
  2360.     END;                
  2361.  
  2362.   SET_CURSOR(UNDERLINE);
  2363.   SX := UT.TIMEX;
  2364.   SY := UT.TIMEY;
  2365.   UT.TIMEX := XLOC;
  2366.   UT.TIMEY := YLOC;
  2367.   IF NOT (DISPLAY IN EXITCH) THEN
  2368.     REPEAT
  2369.  
  2370.       FW(START,Y,IATTR,COPY(INSTRING,OFS,WIN));
  2371.  
  2372.       GOTOXY(START+X-1,Y);
  2373.       CH := CH1;
  2374.       READCH(CH,FALSE);
  2375.       SAVECH := CH;
  2376.       CASE CH OF
  2377.           HOMEKEY : BEGIN
  2378.                       OFS := 1;
  2379.                       X := 1;
  2380.                     END;
  2381.            ENDKEY : BEGIN
  2382.                       X := LEN;
  2383.                       WHILE (X > 2) AND (INSTRING[X-1] = ' ') DO
  2384.                         X := PRED(X);
  2385.                       IF (X = 1) AND (INSTRING[1] = ' ') THEN
  2386.                         X := 1;
  2387.                       OFS := X - (WIN - 2);
  2388.                       IF OFS < 1 THEN OFS := 1;
  2389.                       X := WIN;
  2390.                       WHILE (X > 1) AND (INSTRING[X+OFS-2] = ' ') DO
  2391.                         X := PRED(X);
  2392.                       IF X + OFS > LEN THEN
  2393.                         OFS := PRED(OFS);
  2394.                     END;
  2395.                #8 : IF (X > 1) THEN
  2396.                       BEGIN
  2397.                         DELETE(INSTRING,X-1+OFS-1,1);
  2398.                         INSTRING := INSTRING + ' ';
  2399.                         X := PRED(X);
  2400.                       END
  2401.                     ELSE
  2402.                       IF X > 1 THEN
  2403.                         X := PRED(X)
  2404.                       ELSE
  2405.                         BEGIN
  2406.                           SAVECH := CH;
  2407.                           IF NOCONV IN EXITCH THEN
  2408.                             CH := NOCONV
  2409.                           ELSE
  2410.                             CH := UP;
  2411.                         END;
  2412.             RIGHT : IF X < WIN THEN
  2413.                       X := SUCC(X)
  2414.                     ELSE
  2415.                       IF OFS + WIN <= LEN THEN
  2416.                         OFS := SUCC(OFS)
  2417.                       ELSE
  2418.                         BEGIN
  2419.                           SAVECH := CH;
  2420.                           IF NOCONV IN EXITCH THEN
  2421.                             CH := NOCONV
  2422.                           ELSE
  2423.                             CH := DOWN;
  2424.                         END;
  2425.              LEFT : IF X > 1 THEN
  2426.                       X := PRED(X)
  2427.                     ELSE
  2428.                       IF OFS > 1 THEN
  2429.                         OFS := PRED(OFS)
  2430.                       ELSE
  2431.                         BEGIN
  2432.                           SAVECH := CH;
  2433.                           IF NOCONV IN EXITCH THEN
  2434.                             CH := NOCONV
  2435.                           ELSE
  2436.                             CH := UP;
  2437.                         END;
  2438.          ' '..'~' : IF CH IN VALID THEN
  2439.                       IF INSON THEN
  2440.                         BEGIN
  2441.                           IF INSTRING[LEN] = ' ' THEN
  2442.                             BEGIN
  2443.                               DELETE(INSTRING,LENGTH(INSTRING),1);
  2444.                               IF (CAPWO AND ((X = 1) OR (INSTRING[X+OFS-2] = ' '))) OR
  2445.                                  CAPIT THEN
  2446.                                 CH := UPCASE(CH);
  2447.                               INSERT(CH,INSTRING,X+OFS-1);
  2448.                               IF X < WIN THEN
  2449.                                 X := SUCC(X)
  2450.                               ELSE
  2451.                                 IF OFS + WIN <= LEN THEN
  2452.                                   OFS := SUCC(OFS)
  2453.                                 ELSE
  2454.                                   BEGIN
  2455.                                     SAVECH := RIGHT;
  2456.                                     IF NOCONV IN EXITCH THEN
  2457.                                       CH := NOCONV
  2458.                                     ELSE
  2459.                                       CH := DOWN;
  2460.                                   END;
  2461.                             END
  2462.                           ELSE
  2463.                             BEEP;
  2464.                         END
  2465.                       ELSE
  2466.                         BEGIN
  2467.                           IF (CAPWO AND ((X = 1) OR (INSTRING[X+OFS-2] = ' '))) OR
  2468.                              CAPIT THEN
  2469.                             CH := UPCASE(CH);
  2470.                           INSTRING[X+OFS-1] := CH;
  2471.                           IF X < WIN THEN
  2472.                             X := SUCC(X)
  2473.                           ELSE
  2474.                             IF OFS + WIN <= LEN THEN
  2475.                               OFS := SUCC(OFS)
  2476.                             ELSE
  2477.                               BEGIN
  2478.                                 SAVECH := RIGHT;
  2479.                                 IF NOCONV IN EXITCH THEN
  2480.                                   CH := NOCONV
  2481.                                 ELSE
  2482.                                   CH := DOWN;
  2483.                               END;
  2484.                         END;
  2485.            INSKEY : BEGIN
  2486.                       INSON := NOT INSON;
  2487.                       IF INSON THEN
  2488.                         SET_CURSOR(BLOCK)
  2489.                       ELSE
  2490.                         BEGIN
  2491.                           SET_CURSOR(UNDERLINE);
  2492.                           INSON := FALSE;
  2493.                         END;
  2494.                     END;
  2495.            DELKEY : BEGIN
  2496.                       DELETE(INSTRING,X+OFS-1,1);
  2497.                       INSTRING := INSTRING + ' ';
  2498.                       GOTOXY(START,Y);
  2499.                     END;
  2500.             ALT_C : BEGIN
  2501.                       FOR I := 1 TO LEN DO
  2502.                         INSTRING[I] := ' ';
  2503.                       X := 1;
  2504.                       OFS := 1;
  2505.                     END;
  2506.       END;
  2507.       FW(START,Y,IATTR,COPY(INSTRING,OFS,WIN));
  2508.       IF X > LEN THEN X := LEN;
  2509.     UNTIL (CH = #27) OR (CH IN EXITCH);
  2510.   UT.TIMEX := SX;
  2511.   UT.TIMEY := SY;
  2512.   IF NOCONV IN EXITCH THEN
  2513.     CH := SAVECH;
  2514.   X_IN := 1;
  2515.   X_OUT := X+OFS-1;
  2516.   SET_CURSOR(UNDERLINE);
  2517.   CHANGED := INSTRING <> OLDVAL;
  2518. END;
  2519.  
  2520. PROCEDURE CENTER_PRINT(LINE     : STRING;
  2521.                         LEN     : INTEGER;
  2522.                     VAR NEXTPOS : INTEGER;
  2523.                         CR      : BOOLEAN);
  2524. BEGIN
  2525.   NEXTPOS := ((LEN DIV 2) + (LENGTH(LINE) DIV 2)) + 1;
  2526.   IF CR THEN
  2527.     WRITELN(LST,LINE:NEXTPOS-1)
  2528.   ELSE
  2529.     WRITE(LST,LINE:NEXTPOS-1);
  2530. END;
  2531.  
  2532. PROCEDURE CLEAR_BUFFER(VAR SCREEN : BUFFER;
  2533.                          ATTR : INTEGER);
  2534. VAR
  2535.   I : INTEGER;
  2536. BEGIN
  2537.   I := 1;
  2538.   REPEAT
  2539.     SCREEN[I] := ' ';
  2540.     SCREEN[I+1] := CHAR(ATTR);
  2541.     I := I + 2;
  2542.   UNTIL I > 3999;
  2543. END;
  2544.  
  2545. PROCEDURE FWB(VAR SCREEN : BUFFER;
  2546.                 X,Y,ATTR : INTEGER;
  2547.                 INSTRING : STR80);
  2548. VAR
  2549.   I,Z : INTEGER;
  2550. BEGIN
  2551.   Z := (((Y * 160) - 160) + (X * 2)) - 1;
  2552.   FOR I := 1 TO LENGTH(INSTRING) DO
  2553.     IF Z < 4000 THEN
  2554.       BEGIN
  2555.         SCREEN[Z] := INSTRING[I];
  2556.         SCREEN[Z+1] := CHR(ATTR);
  2557.         Z := Z + 2;
  2558.       END;
  2559. END;
  2560.  
  2561. FUNCTION CREATE_NEW_FILE(FILENAME, MESS : STR80) : BOOLEAN;
  2562. VAR
  2563.   CH : CHAR;
  2564.   SC : BUFFER;
  2565. BEGIN
  2566.   SAVE_SCREEN(SC);
  2567.   FW(10,15,$04,'╒══════════════════════════════════════════════════╕');
  2568.   FW(10,16,$04,'│               FILE NOT FOUND !!                  │');
  2569.   FW(10,17,$04,'│                                                  │');
  2570.   FW(10,18,$04,'│                                                  │');
  2571.   FW(10,19,$04,'│                                                  │');
  2572.   FW(10,20,$04,'│   Contact:                                       │');
  2573.   FW(10,21,$04,'│                                                  │');
  2574.   FW(10,22,$04,'│        Press <any Key> to Abort Program          │');
  2575.   FW(10,23,$04,'╘══════════════════════════════════════════════════╛');
  2576.   FW(28,18,$0F,FILENAME);
  2577.   FW(23,20,$0F,MESS);
  2578.   GOTOXY(52,22);
  2579.   WHILE KEYPRESSED DO
  2580.     CH := READKEY;
  2581.   READCH(CH,FALSE);
  2582.   CREATE_NEW_FILE := CH = AF1;
  2583.   REBUILD_SCREEN(SC);
  2584. END;
  2585.  
  2586. FUNCTION INT_STR(I,LEN : INTEGER) : STR80;
  2587. VAR
  2588.   TEMP   : STR80;
  2589. BEGIN
  2590.   STR(I:LEN,TEMP);
  2591.   INT_STR := TEMP;
  2592. END;
  2593.  
  2594. FUNCTION REAL_STR(R : REAL; LEN, PLACES : INTEGER) : STR80;
  2595. VAR
  2596.   TEMP   : STR80;
  2597. BEGIN
  2598.   STR(R:LEN:PLACES,TEMP);
  2599.   REAL_STR := TEMP;
  2600. END;
  2601.  
  2602. FUNCTION LONGINT_STR(I : LONGINT; LEN : INTEGER) : STR80;
  2603. VAR
  2604.   TEMP   : STR80;
  2605. BEGIN
  2606.   STR(I:LEN,TEMP);
  2607.   LONGINT_STR := TEMP;
  2608. END;
  2609.  
  2610. FUNCTION DATE_TIME_KEY : STR16;
  2611. VAR
  2612.   YEAR, MON, DAY, DOW,
  2613.   HOUR, MIN, SEC, SEC100 : WORD;
  2614.   TEMP1,
  2615.   TEMP2                  : STR16;
  2616. BEGIN
  2617.   GETDATE(YEAR,MON,DAY,DOW);
  2618.   GETTIME(HOUR,MIN,SEC,SEC100);
  2619.   STR(YEAR:4,TEMP1);
  2620.   STR(MON:2,TEMP2);
  2621.   IF TEMP2[1] = ' ' THEN TEMP2[1] := '0';
  2622.   TEMP1 := TEMP1 + TEMP2;
  2623.   STR(DAY:2,TEMP2);
  2624.   IF TEMP2[1] = ' ' THEN TEMP2[1] := '0';
  2625.   TEMP1 := TEMP1 + TEMP2;
  2626.   STR(HOUR:2,TEMP2);
  2627.   IF TEMP2[1] = ' ' THEN TEMP2[1] := '0';
  2628.   TEMP1 := TEMP1 + TEMP2;
  2629.   STR(MIN:2,TEMP2);
  2630.   IF TEMP2[1] = ' ' THEN TEMP2[1] := '0';
  2631.   TEMP1 := TEMP1 + TEMP2;
  2632.   STR(SEC:2,TEMP2);
  2633.   IF TEMP2[1] = ' ' THEN TEMP2[1] := '0';
  2634.   TEMP1 := TEMP1 + TEMP2;
  2635.   STR(SEC100:2,TEMP2);
  2636.   IF TEMP2[1] = ' ' THEN TEMP2[1] := '0';
  2637.   TEMP1 := TEMP1 + TEMP2;
  2638.   DATE_TIME_KEY := TEMP1;
  2639. END;
  2640.  
  2641. FUNCTION STRIP(ST : STRING; IMBED : BOOLEAN) : STRING;
  2642. BEGIN
  2643.   WHILE (LENGTH(ST) > 0) AND (ST[1] = ' ') DO
  2644.     DELETE(ST,1,1);
  2645.   WHILE (LENGTH(ST) > 0) AND (ST[LENGTH(ST)] = ' ') DO
  2646.     DELETE(ST,LENGTH(ST),1);
  2647.   IF IMBED THEN
  2648.     WHILE POS('  ',ST) > 0 DO
  2649.       DELETE(ST,POS('  ',ST),1);
  2650.   STRIP := ST;
  2651. END;
  2652.  
  2653. FUNCTION KEY_TO_DATE(ST : STRING) : STRING;
  2654. VAR
  2655.   INT : INTEGER;
  2656.   IND : STRING[2];
  2657.   TMP : STRING[2];
  2658. BEGIN
  2659.   INT := _INTEGER(COPY(ST,9,2));
  2660.   IF INT > 11 THEN
  2661.     IND := 'pm'
  2662.   ELSE
  2663.     IND := 'am';
  2664.   IF INT > 12 THEN
  2665.     INT := INT - 12;
  2666.   TMP := INT_STR(INT,2);
  2667.   IF TMP[1] = ' ' THEN TMP[1] := '0';
  2668.   KEY_TO_DATE := COPY(ST,5,2)+'-'+COPY(ST,7,2)+'-'+COPY(ST,1,4)+' '+
  2669.                   TMP+':'+COPY(ST,11,2)+' '+IND;
  2670. END;
  2671.  
  2672. function Julian(DT : STR8) : longint;
  2673. var
  2674.    Temp, Y, M, D  : longint;
  2675.    Year, Mon, Day : integer;
  2676. begin
  2677.    YEAR := _INTEGER(COPY(DT,7,2));
  2678.    MON  := _INTEGER(COPY(DT,1,2));
  2679.    DAY  := _INTEGER(COPY(DT,4,2));
  2680.    if (Year < 0) or (Mon < 1) or (Mon > 12)             {Mod. #1}
  2681.                  or (Day < 1) or (Day > 31) then
  2682.       begin
  2683.          Julian := -1;
  2684.          exit
  2685.       end;
  2686.    Y := Year;  M := Mon;  D := Day;
  2687.    if Y < 100 then Y := Y + 1900;                       {Mod. #1}
  2688.    Temp   := (M - 14) div 12;
  2689.    Julian := D - 32075 +
  2690.              (1461 * (Y + 4800 + Temp) div 4) +
  2691.              (367 * (M - 2 - Temp * 12) div 12) -
  2692.              (3 * ((Y + 4900 + Temp) div 100) div 4)
  2693. end;
  2694.  
  2695. FUNCTION JulToMDY(JulianDay: longint) : STR8;
  2696. var
  2697.    TempA, TempB, TempC : longint;
  2698.    MON, YEAR, DAY      : INTEGER;
  2699.    TEMP                : STRING[10];
  2700. begin
  2701.    TempA := JulianDay + 68569;
  2702.    TempB := 4 * TempA div 146097;
  2703.    TempA := TempA - (146097 * TempB + 3) div 4;
  2704.    Year  := 4000 * (TempA + 1) div 1461001;
  2705.    TempC := Year;
  2706.    TempA := TempA - (1461 * TempC div 4) + 31;
  2707.    Mon   := 80 * TempA div 2447;
  2708.    TempC := Mon;
  2709.    Day   := TempA - (2447 * TempC div 80);
  2710.    TempA := Mon div 11;
  2711.    Mon   := Mon + 2 - (12 * TempA);
  2712.    Year  := 100 * (TempB - 49) + Year + TempA;
  2713.    TEMP := INT_STR(MON,2) + '-' + INT_STR(DAY,2) + '-' + INT_STR(YEAR,4);
  2714.    IF TEMP[1] = ' ' THEN TEMP[1] := '0';
  2715.    IF TEMP[4] = ' ' THEN TEMP[4] := '0';
  2716.    DELETE(TEMP,7,2);
  2717.    JULTOMDY := TEMP;
  2718. end;
  2719.  
  2720. procedure DayWeek(DT : STR8; var DayNum: integer;
  2721.                   var DayName: Str3);
  2722. VAR
  2723.   CENTURY,
  2724.   Tmp      : Integer;
  2725.   YEAR,
  2726.   MONTH,
  2727.   DAY      : WORD;
  2728. Begin
  2729.   VAL(COPY(DT,7,2),YEAR,TMP);
  2730.   VAL(COPY(DT,1,2),MONTH,TMP);
  2731.   VAL(COPY(DT,4,2),DAY,TMP);
  2732.   If Year < 1900 then
  2733.      Inc(Year,1900);
  2734.   If Month < 3 then
  2735.      Inc(Month, 10)
  2736.   else
  2737.      Dec(Month, 2);
  2738.   If Month > 10 then
  2739.      Dec(Year);
  2740.   Century := Year div 100;
  2741.   Year := Year mod 100;
  2742.   Tmp := Trunc((2.6 * Month - 0.2) + Day + Year + (Year div 4) +
  2743.      (Century div 4) - (2 * Century));
  2744.   DAYNUM := (Tmp + 777) mod 7;
  2745.   CASE DAYNUM OF
  2746.       0 : DAYNAME := 'Sun';
  2747.       1 : DAYNAME := 'Mon';
  2748.       2 : DAYNAME := 'Tue';
  2749.       3 : DAYNAME := 'Wed';
  2750.       4 : DAYNAME := 'Thu';
  2751.       5 : DAYNAME := 'Fri';
  2752.       6 : DAYNAME := 'Sat';
  2753.   END;
  2754. End;
  2755.  
  2756. FUNCTION DUP(MASK : CHAR; N : INTEGER) : STRING;
  2757. VAR
  2758.   ST : STRING;
  2759. BEGIN
  2760.   FILLCHAR(ST,SIZEOF(ST),MASK);
  2761.   IF (N < 256) AND (N > 0) THEN
  2762.     ST[0] := CHR(N)
  2763.   ELSE
  2764.     ST[0] := CHR(0);
  2765.   DUP := ST;
  2766. END;
  2767.  
  2768. PROCEDURE POP_WINDOW(X1,Y1,X2,Y2 : INTEGER; STYLE : INTEGER; ATTR : BYTE);
  2769. VAR
  2770.   I,
  2771.   SHADOW       : BYTE;
  2772.   URCORNER,
  2773.   ULCORNER,
  2774.   LRCORNER,
  2775.   LLCORNER,
  2776.   VERTICAL,
  2777.   HORIZONTAL   : CHAR;
  2778. BEGIN
  2779.   CASE STYLE OF
  2780.      0,
  2781.     10 : BEGIN
  2782.            URCORNER   := ' ';
  2783.            ULCORNER   := ' ';
  2784.            LRCORNER   := ' ';
  2785.            LLCORNER   := ' ';
  2786.            VERTICAL   := ' ';
  2787.            HORIZONTAL := ' ';
  2788.          END;
  2789.      1,
  2790.     11  : BEGIN
  2791.            URCORNER   := '┐';
  2792.            ULCORNER   := '┌';
  2793.            LRCORNER   := '┘';
  2794.            LLCORNER   := '└';
  2795.            VERTICAL   := '│';
  2796.            HORIZONTAL := '─';
  2797.          END;
  2798.     ELSE BEGIN
  2799.            URCORNER   := '╗';
  2800.            ULCORNER   := '╔';
  2801.            LRCORNER   := '╝';
  2802.            LLCORNER   := '╚';
  2803.            VERTICAL   := '║';
  2804.            HORIZONTAL := '═';
  2805.          END;
  2806.   END;
  2807.   FW(X1,Y1,ATTR,ULCORNER+DUP(HORIZONTAL,X2-X1-1)+URCORNER);
  2808.   FOR I := Y1 + 1 TO Y2 - 1 DO
  2809.     FW(X1,I,ATTR,VERTICAL+DUP(' ',X2-X1-1)+VERTICAL);
  2810.   FW(X1,Y2,ATTR,LLCORNER+DUP(HORIZONTAL,X2-X1-1)+LRCORNER);
  2811.  
  2812.   IF STYLE < 10 THEN
  2813.     IF (X2 < 80) AND (Y2 < 25) THEN
  2814.       BEGIN
  2815.         SHADOW := $07;
  2816.         IF Y2 < 25 THEN
  2817.           SET_ATTR([X1+2..X2+2],Y2+1,SHADOW);
  2818.         FOR I := Y1 + 1 TO Y2 + 1 DO
  2819.           IF I <= 25 THEN
  2820.             SET_ATTR([X2+1,X2+2],I,SHADOW);
  2821.       END;
  2822. END;
  2823.  
  2824. FUNCTION GET_FILE_INFO(FILENAME : STRING) : STR80;
  2825. VAR
  2826.   F         : FILE OF BYTE;
  2827.   SAVE_MODE : BYTE;
  2828.   DT        : DATETIME;
  2829.   DATE,
  2830.   SIZE      : LONGINT;
  2831.                                  
  2832.        FUNCTION CONVERT_DATE : STRING;
  2833.        VAR
  2834.          IND         : CHAR;
  2835.          TEMP, TEMP2 : STRING;
  2836.        BEGIN
  2837.          UNPACKTIME(DATE,DT);
  2838.          STR(DT.MONTH:2,TEMP2);
  2839.          STR(DT.DAY:2,TEMP);
  2840.          IF TEMP[1] = ' ' THEN TEMP[1] := '0';
  2841.          TEMP2 := TEMP2 + '-' + TEMP;
  2842.          STR(DT.YEAR:4,TEMP);
  2843.          TEMP2 := TEMP2 + '-' + COPY(TEMP,3,2);
  2844.          IF DT.HOUR >= 12 THEN
  2845.            BEGIN
  2846.              IND := 'p';
  2847.              IF DT.HOUR > 12 THEN
  2848.                DT.HOUR := DT.HOUR - 12;
  2849.            END
  2850.          ELSE
  2851.            IND := 'a';
  2852.          STR(DT.HOUR:2,TEMP);
  2853.          TEMP2 := TEMP2 + ' ' + TEMP + ':';
  2854.          STR(DT.MIN:2,TEMP);
  2855.          IF TEMP[1] = ' ' THEN TEMP[1] := '0';
  2856.          TEMP2 := TEMP2 + TEMP + IND;
  2857.          IF (DT.HOUR=0) AND (DT.MIN=0) AND (DT.SEC=0) THEN
  2858.            BEGIN
  2859.              TEMP2 := COPY(TEMP2,1,10);
  2860.              TEMP2 := TEMP2 + SPACES(5);
  2861.            END;
  2862.          CONVERT_DATE := TEMP2;
  2863.        END;
  2864.  
  2865. BEGIN
  2866.   SAVE_MODE := FILEMODE;
  2867.   FILEMODE  := 0;
  2868.   ASSIGN(F,FILENAME);
  2869.   {$I-}
  2870.     RESET(F);
  2871.   {$I+}
  2872.   IF IORESULT = 0 THEN
  2873.     BEGIN
  2874.       SIZE := FILESIZE(F);
  2875.       GETFTIME(F,DATE);
  2876.       CLOSE(F);
  2877.       GET_FILE_INFO := LONGINT_STR(SIZE,9)+' '+CONVERT_DATE;
  2878.     END
  2879.   ELSE
  2880.     GET_FILE_INFO := '';
  2881.   FILEMODE := SAVE_MODE;
  2882. END;
  2883.  
  2884. PROCEDURE SAVE_LINE(Y : INTEGER; VAR STR : BUF160);
  2885. VAR
  2886.   Z : INTEGER;
  2887. BEGIN
  2888.   Z := (((Y * 160) - 160) + 2) - 1;
  2889.   MOVE(P^[Z],STR,160);
  2890. END;
  2891.  
  2892. PROCEDURE REBUILD_LINE(Y : INTEGER; STR : BUF160);
  2893. VAR
  2894.   Z : INTEGER;
  2895. BEGIN
  2896.   Z := (((Y * 160) - 160) + 2) - 1;
  2897.   MOVE(STR,P^[Z],160);
  2898. END;
  2899.  
  2900. PROCEDURE FILL_SCREEN(X1,Y1,X2,Y2 : INTEGER; CH : CHAR; ATTR : INTEGER);
  2901. VAR
  2902.   X,Y,
  2903.   Z   : INTEGER;
  2904.   SC  : BUFFER;
  2905. BEGIN
  2906.   SAVE_SCREEN(SC);
  2907.   FOR Y := Y1 TO Y2 DO
  2908.     FOR X := X1 TO X2 DO
  2909.       BEGIN
  2910.         Z := (((Y * 160) - 160) + (X * 2)) - 1;
  2911.         SC[Z] := CH;
  2912.         SC[Z+1] := CHR(ATTR);
  2913.       END;
  2914.   REBUILD_SCREEN(SC);
  2915. END;
  2916.  
  2917. FUNCTION PROGRAM_LOCATION : STRING;
  2918. VAR
  2919.   TEMP,
  2920.   DIR,
  2921.   NAME,
  2922.   EXT    : STRING;
  2923. BEGIN
  2924.   TEMP := PARAMSTR(0);
  2925.   FSPLIT(TEMP,DIR,NAME,EXT);
  2926.   PROGRAM_LOCATION := DIR;
  2927. END;
  2928.  
  2929. PROCEDURE REBOOT;
  2930. BEGIN
  2931. INLINE(
  2932.   $B8/$40/$00/
  2933.   $8E/$D8/
  2934.   $C7/$06/$72/$00/$34/$12/
  2935.   $EA/$00/$00/$FF/$FF);
  2936. END;
  2937.  
  2938. procedure SetBlink(On : Boolean);
  2939.   {-Enable text mode attribute blinking if On is True}
  2940. const
  2941.   PortVal : array[0..4] of Byte = ($0C, $08, $0D, $09, $09);
  2942. var
  2943.   PortNum : Word;
  2944.   Index : Byte;
  2945.   PVal : Byte;
  2946. begin
  2947.   IF EGA_PRESENT THEN
  2948.     begin
  2949.         inline(
  2950.           $8A/$5E/<On/     {mov bl,[bp+<On]}
  2951.           $B8/$03/$10/     {mov ax,$1003}
  2952.           $CD/$10);        {int $10}
  2953.         Exit;
  2954.     end
  2955.   ELSE
  2956.     IF CGA_PRESENT THEN
  2957.       begin
  2958.         PortNum := $3D8;
  2959.         case LastMode of
  2960.           0..3 : Index := LastMode;
  2961.           else Exit;
  2962.         end;
  2963.       end
  2964.     ELSE
  2965.       begin
  2966.         PortNum := $3B8;
  2967.         Index := 4;
  2968.       end;
  2969.   PVal := PortVal[Index];
  2970.   if On then
  2971.     PVal := PVal or $20;
  2972.   Port[PortNum] := PVal;
  2973. end;
  2974.  
  2975. PROCEDURE BLINK_OFF;
  2976. BEGIN
  2977.   SetBlink(False);
  2978.   BLINK_IS_ON := FALSE;
  2979. END;
  2980.  
  2981. PROCEDURE BLINK_ON;
  2982. BEGIN
  2983.   SetBlink(True);
  2984.   BLINK_IS_ON := TRUE;
  2985. END;
  2986.  
  2987. PROCEDURE SET_BORDER(COLOR : INTEGER);
  2988. VAR
  2989.   REGS         : REGISTERS;
  2990.   MONITOR_INFO : BYTE;
  2991. BEGIN
  2992.   MONITOR_INFO := MEM[SEG0040:$0010];
  2993.   CURRENT_BORDER := COLOR;
  2994.   IF (EGA_PRESENT) OR (VGA_PRESENT) THEN
  2995.     BEGIN
  2996.       REGS.AH := $10;
  2997.       REGS.AL := 1;
  2998.       REGS.BH := COLOR;
  2999.       INTR($10,REGS);
  3000.     END
  3001.   ELSE
  3002.     PORT[$03D9]:=15 AND COLOR;
  3003. END;
  3004.  
  3005. PROCEDURE SCREEN_ON;
  3006. VAR
  3007.   REGS         : REGISTERS;
  3008.   MONITOR_INFO : BYTE;
  3009. BEGIN
  3010.   MONITOR_INFO := MEM[SEG0040:$0010];
  3011.   IF EGA_PRESENT OR VGA_PRESENT THEN
  3012.     BEGIN
  3013.       REGS.AH := $12;
  3014.       REGS.AL := 0;
  3015.       REGS.BL := $36;
  3016.       INTR($10,REGS);
  3017.     END
  3018.   ELSE
  3019.     BEGIN
  3020.       IF MONITOR_INFO AND 48 = 48 THEN
  3021.         PORT[952]:=255
  3022.       ELSE
  3023.         PORT[984]:=41;
  3024.     END;
  3025.   SET_BORDER(CURRENT_BORDER);
  3026. END;
  3027.  
  3028. PROCEDURE SCREEN_OFF;
  3029. VAR
  3030.   REGS         : REGISTERS;
  3031.   MONITOR_INFO : BYTE;
  3032. BEGIN
  3033.   MONITOR_INFO := MEM[SEG0040:$0010];
  3034.   IF EGA_PRESENT OR VGA_PRESENT THEN
  3035.     BEGIN
  3036.       REGS.AH := $12;
  3037.       REGS.AL := 1;
  3038.       REGS.BL := $36;
  3039.       INTR($10,REGS);
  3040.     END
  3041.   ELSE
  3042.     BEGIN
  3043.       IF MONITOR_INFO AND 48 = 48 THEN
  3044.         PORT[952]:=1
  3045.       ELSE
  3046.         PORT[984]:=1;
  3047.     END;
  3048.   IF (EGA_PRESENT) OR (VGA_PRESENT) THEN
  3049.     BEGIN
  3050.       REGS.AH := $10;
  3051.       REGS.AL := 1;
  3052.       REGS.BH := 0;
  3053.       INTR($10,REGS);
  3054.     END
  3055.   ELSE
  3056.     PORT[$03D9]:=15 AND 0;
  3057. END;
  3058.  
  3059. PROCEDURE POP_MESSAGE(X,Y : INTEGER; BORDER, ATTR : BYTE;
  3060.                          MATTR : BYTE; MESSAGE : STR80);
  3061. BEGIN
  3062.   IF X = 0 THEN
  3063.     X := 40 - ((LENGTH(MESSAGE) + 3) DIV 2);
  3064.   POP_WINDOW(X,Y,X+LENGTH(MESSAGE)+3,Y+2,BORDER,ATTR);
  3065.   FW(X+2,Y+1,MATTR,MESSAGE);
  3066.   GOTOXY(X+LENGTH(MESSAGE)+2,Y+1);
  3067. END;
  3068.  
  3069. PROCEDURE POP_WINDOW_TITLE(   X,Y,X1,Y1 : INTEGER;
  3070.                            BORDER, ATTR : BYTE;
  3071.                                   TATTR,
  3072.                                      TY : BYTE;
  3073.                                   TITLE : STR80);
  3074. BEGIN
  3075.   POP_WINDOW(X,Y,X1,Y1,BORDER,ATTR);
  3076.   FW((X+((X1-X) DIV 2) - (LENGTH(TITLE) DIV 2)),TY,TATTR,+' '+TITLE+' ');
  3077. END;
  3078.  
  3079. FUNCTION SHIFT_KEYS(KEY : CHAR) : BOOLEAN;
  3080.  { KEY = 'R' for Right, 'L' for Left, 'C' for Control, 'A' for Alt }
  3081. VAR
  3082.   KEYBOARD : BYTE;
  3083. BEGIN
  3084.   KEYBOARD := MEM[SEG0040:$0017];
  3085.   CASE UPCASE(KEY) OF
  3086.      'R' : SHIFT_KEYS := KEYBOARD AND 1 = 1;
  3087.      'L' : SHIFT_KEYS := KEYBOARD AND 2 = 2;
  3088.      'C' : SHIFT_KEYS := KEYBOARD AND 4 = 4;
  3089.      'A' : SHIFT_KEYS := KEYBOARD AND 8 = 8;
  3090.   END;
  3091. END;
  3092.  
  3093. procedure MasterEnv;
  3094.   {-Return master environment record}
  3095. var
  3096.   Owner : Word;
  3097.   Mcb : Word;
  3098.   Eseg : Word;
  3099.   Done : Boolean;
  3100. begin
  3101.   with Env_Rec do begin
  3102.     FillChar(Env_Rec, SizeOf(Env_Rec), 0);
  3103.  
  3104.     {Interrupt $2E points into COMMAND.COM}
  3105.     Owner := MemW[0:(2+4*$2E)];
  3106.  
  3107.     {Mcb points to memory control block for COMMAND}
  3108.     Mcb := Owner-1;
  3109.     if (Mem[Mcb:0] <> Byte('M')) or (MemW[Mcb:1] <> Owner) then
  3110.       Exit;
  3111.  
  3112.     {Read segment of environment from PSP of COMMAND}
  3113.     Eseg := MemW[Owner:$2C];
  3114.  
  3115.     {Earlier versions of DOS don't store environment segment there}
  3116.     if Eseg = 0 then begin
  3117.       {Master environment is next block past COMMAND}
  3118.       Mcb := Owner+MemW[Mcb:3];
  3119.       if (Mem[Mcb:0] <> Byte('M')) or (MemW[Mcb:1] <> Owner) then
  3120.         {Not the right memory control block}
  3121.         Exit;
  3122.       Eseg := Mcb+1;
  3123.     end else
  3124.       Mcb := Eseg-1;
  3125.  
  3126.     {Return segment and length of environment}
  3127.     EnvSeg := Eseg;
  3128.     EnvLen := MemW[Mcb:3] shl 4;
  3129.   end;
  3130. end;
  3131.  
  3132. procedure SkipAsciiZ(EPtr : EnvArrayPtr; var EOfs : Word);
  3133.   {-Skip to end of current AsciiZ string}
  3134. begin
  3135.   while EPtr^[EOfs] <> #0 do
  3136.     Inc(EOfs);
  3137. end;
  3138.  
  3139. function EnvNext(EPtr : EnvArrayPtr) : Word;
  3140.   {-Return the next available location in environment at EPtr^}
  3141. var
  3142.   EOfs : Word;
  3143. begin
  3144.   EOfs := 0;
  3145.   if EPtr <> nil then begin
  3146.     while EPtr^[EOfs] <> #0 do begin
  3147.       SkipAsciiZ(EPtr, EOfs);
  3148.       Inc(EOfs);
  3149.     end;
  3150.   end;
  3151.   EnvNext := EOfs;
  3152. end;
  3153.  
  3154. function SearchEnv(EPtr : EnvArrayPtr;
  3155.                    var Search : string) : Word;
  3156.   {-Return the position of Search in environment, or $FFFF if not found.
  3157.     Prior to calling SearchEnv, assure that
  3158.       EPtr is not nil,
  3159.       Search is not empty
  3160.   }
  3161. var
  3162.   SLen : Byte absolute Search;
  3163.   EOfs : Word;
  3164.   MOfs : Word;
  3165.   SOfs : Word;
  3166.   Match : Boolean;
  3167. begin
  3168.   {Force upper case search}
  3169.   Search := UPPERCASE(Search);
  3170.  
  3171.   {Assure search string ends in =}
  3172.   if Search[SLen] <> '=' then begin
  3173.     Inc(SLen);
  3174.     Search[SLen] := '=';
  3175.   end;
  3176.  
  3177.   EOfs := 0;
  3178.   while EPtr^[EOfs] <> #0 do begin
  3179.     {At the start of a new environment element}
  3180.     SOfs := 1;
  3181.     MOfs := EOfs;
  3182.     repeat
  3183.       Match := (EPtr^[EOfs] = Search[SOfs]);
  3184.       if Match then begin
  3185.         Inc(EOfs);
  3186.         Inc(SOfs);
  3187.       end;
  3188.     until not Match or (SOfs > SLen);
  3189.  
  3190.     if Match then begin
  3191.       {Found a match, return index of start of match}
  3192.       SearchEnv := MOfs;
  3193.       Exit;
  3194.     end;
  3195.  
  3196.     {Skip to end of this environment string}
  3197.     SkipAsciiZ(EPtr, EOfs);
  3198.  
  3199.     {Skip to start of next environment string}
  3200.     Inc(EOfs);
  3201.   end;
  3202.  
  3203.   {No match}
  3204.   SearchEnv := $FFFF;
  3205. end;
  3206.  
  3207. procedure GetAsciiZ(EPtr : EnvArrayPtr; var EOfs : Word; var EStr : string);
  3208.   {-Collect AsciiZ string starting at EPtr^[EOfs]}
  3209. var
  3210.   ELen : Byte absolute EStr;
  3211. begin
  3212.   ELen := 0;
  3213.   while (EPtr^[EOfs] <> #0) and (ELen < 255) do begin
  3214.     Inc(ELen);
  3215.     EStr[ELen] := EPtr^[EOfs];
  3216.     Inc(EOfs);
  3217.   end;
  3218. end;
  3219.  
  3220. function SetEnv(Name, Value : string) : Boolean;
  3221.   {-Set environment string, returning true if successful}
  3222. var
  3223.   SLen : Byte absolute Name;
  3224.   VLen : Byte absolute Value;
  3225.   EPtr : EnvArrayPtr;
  3226.   ENext : Word;
  3227.   EOfs : Word;
  3228.   MOfs : Word;
  3229.   OldLen : Word;
  3230.   NewLen : Word;
  3231.   NulLen : Word;
  3232. begin
  3233.   with Env_Rec do begin
  3234.     SetEnv := False;
  3235.     if (EnvSeg = 0) or (SLen = 0) then
  3236.       Exit;
  3237.     EPtr := Ptr(EnvSeg, 0);
  3238.  
  3239.     {Find the search string}
  3240.     EOfs := SearchEnv(EPtr, Name);
  3241.  
  3242.     {Get the index of the next available environment location}
  3243.     ENext := EnvNext(EPtr);
  3244.  
  3245.     {Get total length of new environment string}
  3246.     NewLen := SLen+VLen;
  3247.  
  3248.     if EOfs <> $FFFF then begin
  3249.       {Search string exists}
  3250.       MOfs := EOfs+SLen;
  3251.       {Scan to end of string}
  3252.       SkipAsciiZ(EPtr, MOfs);
  3253.       OldLen := MOfs-EOfs;
  3254.       {No extra nulls to add}
  3255.       NulLen := 0;
  3256.     end else begin
  3257.       OldLen := 0;
  3258.       {One extra null to add}
  3259.       NulLen := 1;
  3260.     end;
  3261.  
  3262.     if VLen <> 0 then
  3263.       {Not a pure deletion}
  3264.       if ENext+NewLen+NulLen >= EnvLen+OldLen then
  3265.         {New string won't fit}
  3266.         Exit;
  3267.  
  3268.     if OldLen <> 0 then begin
  3269.       {Overwrite previous environment string}
  3270.       Move(EPtr^[MOfs+1], EPtr^[EOfs], ENext-MOfs-1);
  3271.       {More space free now}
  3272.       Dec(ENext, OldLen+1);
  3273.     end;
  3274.  
  3275.     {Append new string}
  3276.     if VLen <> 0 then begin
  3277.       Move(Name[1], EPtr^[ENext], SLen);
  3278.       Inc(ENext, SLen);
  3279.       Move(Value[1], EPtr^[ENext], VLen);
  3280.       Inc(ENext, VLen);
  3281.     end;
  3282.  
  3283.     {Clear out the rest of the environment}
  3284.     FillChar(EPtr^[ENext], EnvLen-ENext, 0);
  3285.  
  3286.     SetEnv := True;
  3287.   end;
  3288. end;
  3289.  
  3290. PROCEDURE READ_R(     X,Y : INTEGER;
  3291.                     VAR R : REAL;
  3292.                       MIN,
  3293.                       MAX : REAL;
  3294.                    PLACES : INTEGER;
  3295.                RIGHT_JUST : INTEGER;
  3296.                    ICOMMA : BOOLEAN);
  3297. var
  3298.   temp : string[80];
  3299.   len  : integer;
  3300.   SAT  : BYTE;
  3301.   S    : BUF160;
  3302. begin
  3303.   str(max:0:places,temp); 
  3304.   LEN := LENGTH(TEMP);
  3305.   str(r:0:places,temp);
  3306.   sat := screen_attr(x,y);
  3307.   textattr := sat;
  3308.   FW(X,Y,SAT,SPACES(RIGHT_JUST));
  3309.   IF MIN < 0.0 THEN
  3310.     BEGIN
  3311.       len := LEN + 1;                   { +1 FOR MINUS SIGN }
  3312.       REPEAT
  3313.         read_str(x,y,temp,dup('+',len));
  3314.        IF (_REAL(TEMP) < MIN) OR (_REAL(TEMP) > MAX) THEN
  3315.          BEGIN
  3316.            SAVE_LINE(Y+1,S);
  3317.            TEXTATTR := $4F;
  3318.            IF X > 30 THEN
  3319.              GOTOXY(30,Y+1)
  3320.            ELSE
  3321.              GOTOXY(X,Y+1);
  3322.            WRITE(' Range: ',MIN:0:PLACES,' to ',MAX:0:PLACES,'  Press <any key> ',CHR(8));
  3323.            READCH(CH,FALSE);
  3324.            REBUILD_LINE(Y+1,S);
  3325.            TEXTATTR := SAT;
  3326.          END;
  3327.       UNTIL (_REAL(TEMP) >= MIN) AND (_REAL(TEMP) <= MAX);
  3328.     END
  3329.   ELSE
  3330.     REPEAT
  3331.       READ_STR(X,Y,TEMP,DUP('.',LEN));
  3332.       IF (_REAL(TEMP) < MIN) OR (_REAL(TEMP) > MAX) THEN
  3333.         BEGIN
  3334.           SAVE_LINE(Y+1,S);
  3335.           TEXTATTR := $4F;
  3336.           IF X > 30 THEN
  3337.             GOTOXY(30,Y+1)
  3338.           ELSE
  3339.             GOTOXY(X,Y+1);
  3340.           WRITE(' Range: ',MIN:0:PLACES,' to ',MAX:0:PLACES,'  Press <any key> ',CHR(8));
  3341.           READCH(CH,FALSE);
  3342.           REBUILD_LINE(Y+1,S);
  3343.           TEXTATTR := SAT;
  3344.         END;
  3345.     UNTIL (_REAL(TEMP) >= MIN) AND (_REAL(TEMP) <= MAX);
  3346.   r := _real(temp);
  3347.   str(r:0:places,temp);               { THIS TRUNCATES ANYTHING }
  3348.   r := _real(temp);                   { PAST PLACES             }
  3349.   textattr := screen_attr(x,y);
  3350.   gotoxy(x,y);
  3351.   IF ICOMMA THEN
  3352.     write(comma(r,RIGHT_JUST,places,RNUM))
  3353.   ELSE
  3354.     WRITE(R:RIGHT_JUST:PLACES);
  3355. end;
  3356.  
  3357. PROCEDURE READ_I(     X,Y : INTEGER;
  3358.                     VAR R : INTEGER;
  3359.                       MIN,
  3360.                       MAX : INTEGER;
  3361.                RIGHT_JUST : INTEGER;
  3362.                    ICOMMA : BOOLEAN);
  3363. var
  3364.   temp : string[80];
  3365.   len  : integer;
  3366.   SAT  : BYTE;
  3367.   S    : BUF160;
  3368. begin
  3369.   str(max:0,temp);
  3370.   LEN := LENGTH(TEMP);
  3371.   str(r:0,temp);
  3372.   sat := screen_attr(x,y);
  3373.   textattr := sat;
  3374.   GOTOXY(X,Y);
  3375.   WRITE(' ':RIGHT_JUST);
  3376.   IF MIN < 0.0 THEN
  3377.     BEGIN
  3378.       len := LEN + 1;                   { +1 FOR MINUS SIGN }
  3379.       REPEAT
  3380.         read_str(x,y,temp,dup('+',len));
  3381.        IF (_INTEGER(TEMP) < MIN) OR (_INTEGER(TEMP) > MAX) THEN
  3382.          BEGIN
  3383.            SAVE_LINE(Y+1,S);
  3384.            TEXTATTR := $4F;
  3385.            IF X > 30 THEN
  3386.              GOTOXY(30,Y+1)
  3387.            ELSE
  3388.              GOTOXY(X,Y+1);
  3389.            WRITE(' Range: ',MIN:0,' to ',MAX:0,'  Press <any key> ',CHR(8));
  3390.            READCH(CH,FALSE);
  3391.            REBUILD_LINE(Y+1,S);
  3392.            TEXTATTR := SAT;
  3393.          END;
  3394.       UNTIL (_INTEGER(TEMP) >= MIN) AND (_INTEGER(TEMP) <= MAX);
  3395.     END
  3396.   ELSE
  3397.     REPEAT
  3398.       READ_STR(X,Y,TEMP,DUP('.',LEN));
  3399.       IF (_INTEGER(TEMP) < MIN) OR (_INTEGER(TEMP) > MAX) THEN
  3400.         BEGIN
  3401.           SAVE_LINE(Y+1,S);
  3402.           TEXTATTR := $4F;
  3403.           IF X > 30 THEN
  3404.             GOTOXY(30,Y+1)
  3405.           ELSE
  3406.             GOTOXY(X,Y+1);
  3407.           WRITE(' Range: ',MIN:0,' to ',MAX:0,'  Press <any key> ',CHR(8));
  3408.           READCH(CH,FALSE);
  3409.           REBUILD_LINE(Y+1,S);
  3410.           TEXTATTR := SAT;
  3411.         END;
  3412.     UNTIL (_INTEGER(TEMP) >= MIN) AND (_INTEGER(TEMP) <= MAX);
  3413.   r := _INTEGER(temp);
  3414.   str(r:0,temp);               { THIS TRUNCATES ANYTHING }
  3415.   r := _INTEGER(temp);                   { PAST PLACES             }
  3416.   textattr := screen_attr(x,y);
  3417.   gotoxy(x,y);
  3418.   IF ICOMMA THEN
  3419.     write(comma(r,RIGHT_JUST,0,INUM))
  3420.   ELSE
  3421.     WRITE(R:RIGHT_JUST);
  3422. end;
  3423.  
  3424. PROCEDURE READ_L(     X,Y : INTEGER;
  3425.                     VAR R : LONGINT;
  3426.                       MIN,
  3427.                       MAX : LONGINT;
  3428.                RIGHT_JUST : LONGINT;
  3429.                    ICOMMA : BOOLEAN);
  3430. var
  3431.   temp : string[80];
  3432.   len  : integer;
  3433.   SAT  : BYTE;
  3434.   S    : BUF160;
  3435. begin
  3436.   str(max:0,temp);
  3437.   LEN := LENGTH(TEMP);
  3438.   str(r:0,temp);
  3439.   sat := screen_attr(x,y);
  3440.   textattr := sat;
  3441.   GOTOXY(X,Y);
  3442.   WRITE(' ':RIGHT_JUST);
  3443.   IF MIN < 0.0 THEN
  3444.     BEGIN
  3445.       len := LEN + 1;                   { +1 FOR MINUS SIGN }
  3446.       REPEAT
  3447.         read_str(x,y,temp,dup('+',len));
  3448.        IF (_LONGINT(TEMP) < MIN) OR (_LONGINT(TEMP) > MAX) THEN
  3449.          BEGIN
  3450.            SAVE_LINE(Y+1,S);
  3451.            TEXTATTR := $4F;
  3452.            IF X > 30 THEN
  3453.              GOTOXY(30,Y+1)
  3454.            ELSE
  3455.              GOTOXY(X,Y+1);
  3456.            WRITE(' Range: ',MIN:0,' to ',MAX:0,'  Press <any key> ',CHR(8));
  3457.            READCH(CH,FALSE);
  3458.            REBUILD_LINE(Y+1,S);
  3459.            TEXTATTR := SAT;
  3460.          END;
  3461.       UNTIL (_LONGINT(TEMP) >= MIN) AND (_LONGINT(TEMP) <= MAX);
  3462.     END
  3463.   ELSE
  3464.     REPEAT
  3465.       READ_STR(X,Y,TEMP,DUP('.',LEN));
  3466.       IF (_LONGINT(TEMP) < MIN) OR (_LONGINT(TEMP) > MAX) THEN
  3467.         BEGIN
  3468.           SAVE_LINE(Y+1,S);
  3469.           TEXTATTR := $4F;
  3470.           IF X > 30 THEN
  3471.             GOTOXY(30,Y+1)
  3472.           ELSE
  3473.             GOTOXY(X,Y+1);
  3474.           WRITE(' Range: ',MIN:0,' to ',MAX:0,'  Press <any key> ',CHR(8));
  3475.           READCH(CH,FALSE);
  3476.           REBUILD_LINE(Y+1,S);
  3477.           TEXTATTR := SAT;
  3478.         END;
  3479.     UNTIL (_LONGINT(TEMP) >= MIN) AND (_LONGINT(TEMP) <= MAX);
  3480.   r := _LONGINT(temp);
  3481.   str(r:0,temp);               { THIS TRUNCATES ANYTHING }
  3482.   r := _LONGINT(temp);                   { PAST PLACES             }
  3483.   textattr := screen_attr(x,y);
  3484.   gotoxy(x,y);
  3485.   IF ICOMMA THEN
  3486.     write(comma(r,RIGHT_JUST,0,LNUM))
  3487.   ELSE
  3488.     WRITE(R:RIGHT_JUST);
  3489. end;
  3490.  
  3491. PROCEDURE READ_MONEY(X,Y : INTEGER;
  3492.                    VAR R : REAL;
  3493.                  DPLACES : INTEGER;
  3494.               RIGHT_JUST : INTEGER;
  3495.                LOW, HIGH : REAL);
  3496. VAR
  3497.   I         : INTEGER;
  3498.   TEMP      : STRING[15];
  3499.   OLDATTR   : BYTE;
  3500.   LEN       : INTEGER;
  3501.   VALID_SET : SET OF CHAR;
  3502.   FACTOR    : REAL;
  3503.   OLD_CUR   : CURTYPE;
  3504. BEGIN
  3505.   OLD_CUR := CUR;
  3506.   SET_CURSOR(UNDERLINE);
  3507.   FACTOR := 1;
  3508.   FOR I := 1 TO DPLACES DO
  3509.     FACTOR := FACTOR * 10;
  3510.   VALID_SET := ['0'..'9',#8];
  3511.   IF R > HIGH THEN R := HIGH;
  3512.   IF R < LOW  THEN R := LOW;
  3513.   OLDATTR := SCREEN_ATTR(X,Y);
  3514.   TEXTATTR := UT.INPUT_ATTR;
  3515.   LEN := LENGTH(COMMA(HIGH,0,DPLACES,RNUM));
  3516.   IF LOW < 0.0 THEN
  3517.     BEGIN                          
  3518.       VALID_SET := VALID_SET + ['-'];
  3519.       IF LENGTH(COMMA(LOW,0,DPLACES,RNUM)) > LEN THEN
  3520.         LEN := LENGTH(COMMA(LOW,0,DPLACES,RNUM));
  3521.     END;
  3522.   CHANGED := FALSE;
  3523.   TEMP := COMMA(R,LEN,DPLACES,RNUM);
  3524.   GOTOXY(X+RIGHT_JUST-LEN,Y);
  3525.   WRITE(TEMP);
  3526.   TEMP := '';
  3527.   REPEAT
  3528.     GOTOXY(X+RIGHT_JUST-1,Y);
  3529.     READCH(CH,FALSE);
  3530.     IF CH IN VALID_SET THEN
  3531.       BEGIN
  3532.         VALID_SET := VALID_SET - ['-'];
  3533.         CHANGED := TRUE;
  3534.         IF CH = #8 THEN
  3535.           DELETE(TEMP,LENGTH(TEMP),1)
  3536.         ELSE
  3537.           IF (_REAL(TEMP+CH) > 0.0) THEN
  3538.             IF (LENGTH(TEMP) < LEN) AND
  3539.                ((_REAL(TEMP+CH) / FACTOR) <= HIGH) THEN
  3540.               TEMP := TEMP + CH
  3541.             ELSE
  3542.           ELSE
  3543.             IF (LENGTH(TEMP) < LEN) AND
  3544.                ((_REAL(TEMP+CH) / FACTOR) >= LOW) THEN
  3545.               TEMP := TEMP + CH;
  3546.         R := _REAL(TEMP) / FACTOR;
  3547.         GOTOXY(X+RIGHT_JUST-LEN,Y);
  3548.         WRITE(COMMA(R,LEN,DPLACES,RNUM));
  3549.         IF CH = '-' THEN
  3550.           BEGIN
  3551.             GOTOXY(X+RIGHT_JUST-LEN,Y);
  3552.             WRITE('-');
  3553.           END;
  3554.       END;
  3555.   UNTIL (CH = #27) OR (UT.EXITCH[ORD(CH)]);
  3556.   TEXTATTR := OLDATTR;
  3557.   GOTOXY(X,Y);
  3558.   WRITE(COMMA(R,RIGHT_JUST,DPLACES,RNUM));
  3559.   TEXTATTR := UT.DEFAULT_ATTR;
  3560.   SET_CURSOR(OLD_CUR);
  3561. END;
  3562.  
  3563. PROCEDURE READ_DIGIT(    X,Y : INTEGER;
  3564.                    VAR VALUE;          
  3565.                   RIGHT_JUST : INTEGER;
  3566.                    LOW, HIGH : LONGINT;
  3567.                        NTYPE : TYPEN);
  3568. VAR
  3569.   TEMP      : STRING[15];
  3570.   OLDATTR   : BYTE;
  3571.   LNUMBER   : LONGINT ABSOLUTE VALUE;
  3572.   INUMBER   : INTEGER ABSOLUTE VALUE;
  3573.   LEN       : INTEGER;
  3574.   VALID_SET : SET OF CHAR;
  3575.   OLD_CUR   : CURTYPE;
  3576. BEGIN
  3577.   OLD_CUR := CUR;
  3578.   SET_CURSOR(UNDERLINE);
  3579.   VALID_SET := ['0'..'9',#8];
  3580.   LEN := LENGTH(COMMA(HIGH,0,0,LNUM));
  3581.   IF LOW < 0 THEN
  3582.     BEGIN
  3583.       VALID_SET := VALID_SET + ['-'];
  3584.       IF LENGTH(COMMA(LOW,0,0,LNUM)) > LEN THEN
  3585.         LEN := LENGTH(COMMA(LOW,0,0,LNUM));
  3586.     END;
  3587.   CASE NTYPE OF
  3588.       LNUM : BEGIN
  3589.                IF LNUMBER > HIGH THEN LNUMBER := HIGH;
  3590.                IF LNUMBER < LOW  THEN LNUMBER := LOW;
  3591.                TEMP := COMMA(LNUMBER,LEN,0,LNUM);
  3592.              END;
  3593.       INUM : BEGIN
  3594.                IF INUMBER > HIGH THEN INUMBER := HIGH;
  3595.                IF INUMBER < LOW  THEN INUMBER := LOW;
  3596.                TEMP := COMMA(INUMBER,LEN,0,INUM);
  3597.              END;
  3598.       ELSE   EXIT;
  3599.   END;
  3600.   OLDATTR := SCREEN_ATTR(X,Y);
  3601.   TEXTATTR := UT.INPUT_ATTR;
  3602.   CHANGED := FALSE;
  3603.   GOTOXY(X+RIGHT_JUST-LEN,Y);
  3604.   WRITE(TEMP);
  3605.   TEMP := '';
  3606.   REPEAT        
  3607.     GOTOXY(X+RIGHT_JUST-1,Y);
  3608.     READCH(CH,FALSE);
  3609.     IF CH IN VALID_SET THEN
  3610.       BEGIN
  3611.         VALID_SET := VALID_SET - ['-'];
  3612.         CHANGED := TRUE;
  3613.         IF CH = #8 THEN
  3614.           DELETE(TEMP,LENGTH(TEMP),1)
  3615.         ELSE
  3616.           CASE NTYPE OF
  3617.              LNUM : IF _LONGINT(TEMP+CH) > 0 THEN
  3618.                       IF (LENGTH(TEMP) < LEN) AND
  3619.                          ((_LONGINT(TEMP+CH) <= HIGH)) THEN
  3620.                         TEMP := TEMP + CH
  3621.                       ELSE
  3622.                     ELSE
  3623.                       IF (LENGTH(TEMP) < LEN) AND
  3624.                          ((_LONGINT(TEMP+CH) >= LOW)) THEN
  3625.                         TEMP := TEMP + CH;
  3626.              INUM : IF _INTEGER(TEMP+CH) > 0 THEN
  3627.                       IF (LENGTH(TEMP) < LEN) AND
  3628.                          ((_INTEGER(TEMP+CH) <= HIGH)) THEN
  3629.                         TEMP := TEMP + CH
  3630.                       ELSE
  3631.                     ELSE
  3632.                       IF (LENGTH(TEMP) < LEN) AND
  3633.                          ((_INTEGER(TEMP+CH) >= LOW)) THEN
  3634.                         TEMP := TEMP+CH;
  3635.           END;
  3636.         GOTOXY(X+RIGHT_JUST-LEN,Y);
  3637.         CASE NTYPE OF
  3638.             LNUM : BEGIN
  3639.                      LNUMBER := _LONGINT(TEMP);
  3640.                      WRITE(COMMA(LNUMBER,LEN,0,LNUM));
  3641.                    END;
  3642.             INUM : BEGIN
  3643.                      INUMBER := _INTEGER(TEMP);
  3644.                      WRITE(COMMA(INUMBER,LEN,0,INUM));
  3645.                    END;
  3646.         END;
  3647.         IF CH = '-' THEN
  3648.           BEGIN
  3649.             GOTOXY(X+RIGHT_JUST-LEN,Y);
  3650.             WRITE('-');
  3651.           END;
  3652.       END;
  3653.   UNTIL (CH = #27) OR (UT.EXITCH[ORD(CH)]);
  3654.   TEXTATTR := OLDATTR;
  3655.   GOTOXY(X+RIGHT_JUST-LEN,Y);
  3656.   CASE NTYPE OF
  3657.       LNUM : BEGIN
  3658.                IF CHANGED THEN
  3659.                  LNUMBER := _LONGINT(TEMP);
  3660.                WRITE(COMMA(LNUMBER,LEN,0,LNUM));
  3661.              END;
  3662.       INUM : BEGIN
  3663.                IF CHANGED THEN
  3664.                  INUMBER := _INTEGER(TEMP);
  3665.                WRITE(COMMA(INUMBER,LEN,0,INUM));
  3666.              END;
  3667.   END;
  3668.   TEXTATTR := UT.DEFAULT_ATTR;
  3669.   SET_CURSOR(OLD_CUR);
  3670. END;
  3671.  
  3672. FUNCTION BLANKS(INSTRING : STRING) : BOOLEAN;
  3673. BEGIN
  3674.   BLANKS := PAD(' ',LENGTH(INSTRING)) = INSTRING;
  3675. END;
  3676.  
  3677. Function PackKey(Dte, Tme : str8) : longint;
  3678. var
  3679.   Dow,
  3680.   sec100 : word;
  3681.   dt     : DateTime;
  3682.   Tlong  : longint;
  3683. begin
  3684.   if Dte = '' then
  3685.     begin
  3686.       GetDate(Dt.Year,Dt.Month,Dt.Day,Dow);
  3687.       GetTime(Dt.Hour,Dt.Min,Dt.Sec,Sec100);
  3688.     end
  3689.   else
  3690.     begin
  3691.       if copy(Dte,7,2) < '80' then
  3692.         Dt.Year  := 2000 + _word(copy(Dte,7,2))
  3693.       else
  3694.         Dt.Year  := 1900 + _word(copy(Dte,7,2));
  3695.       Dt.Month := _word(copy(Dte,1,2));
  3696.       Dt.Day   := _word(copy(Dte,4,2));
  3697.       Dt.Hour  := _word(copy(Tme,1,2));
  3698.       Dt.Min   := _word(copy(Tme,4,2));
  3699.       Dt.Sec   := _word(copy(Tme,7,2));
  3700.     end;
  3701.   PackTime(Dt, Tlong);
  3702.   PackKey := Tlong;
  3703. end;
  3704.  
  3705. Function UnPackKey(PK : longint) : str20;
  3706. var
  3707.   Temp : str20;
  3708.   Dt   : DateTime;
  3709. begin
  3710.   UnPackTime(PK, Dt);
  3711.   temp := longint_str(Dt.Month,2) + '-' +
  3712.           longint_str(Dt.Day,2)   + '-' +
  3713.           longint_str(Dt.Year,2)  + ' ' +
  3714.           longint_str(Dt.Hour,2)  + ':' +
  3715.           longint_str(Dt.Min,2)   + ':' +
  3716.           longint_str(Dt.Sec,2);
  3717.   delete(temp,7,2);
  3718.   if temp[1] = ' ' then temp[1] := '0';
  3719.   if temp[4] = ' ' then temp[4] := '0';
  3720.   if temp[7] = ' ' then temp[7] := '0';
  3721.   if temp[10] = ' ' then temp[10] := '0';
  3722.   if temp[13] = ' ' then temp[13] := '0';
  3723.   if temp[16] = ' ' then temp[16] := '0';
  3724.   UnPackKey := Temp;
  3725. end;
  3726.  
  3727. PROCEDURE StuffBuffer(S : STR16);
  3728. CONST
  3729.   KbStart = $1E;
  3730. VAR
  3731.   N,MAX : BYTE;
  3732.   KbHead : WORD ABSOLUTE $40:$1A;
  3733.   KbTail : WORD ABSOLUTE $40:$1C;
  3734.   KbBuff : ARRAY [0..15] OF WORD ABSOLUTE $40:KbStart;
  3735. BEGIN
  3736.   MAX := 15;
  3737.   IF LENGTH(S) < MAX THEN
  3738.     MAX := LENGTH(S);
  3739.   ASM CLI END;
  3740.   KbHead := KbStart;
  3741.   KbTail := KbStart + 2*MAX;
  3742.   FOR N := 1 TO MAX DO
  3743.     KbBuff[PRED(N)] := WORD(S[N]);
  3744.   ASM STI END;
  3745. END;
  3746.  
  3747. FUNCTION DATE_MATH(DT : STR8; NUM : INTEGER) : STR8;
  3748. BEGIN
  3749.   DATE_MATH := JULTOMDY(JULIAN(DT) + NUM);
  3750. END;
  3751.  
  3752. FUNCTION GET_CHOICE(ATTR1 : BYTE;    { WINDOW Attribute    }
  3753.                     ATTR2 : BYTE;    { LIGHT-BAR Attribute }
  3754.                     ATTR3 : BYTE;    { Hot-Key Attribute   }
  3755.                     TITLE,
  3756.                     S1    : STR80;
  3757.                     P1    : BYTE;
  3758.                     S2    : STR80;
  3759.                     P2    : BYTE;
  3760.                     S3    : STR80;
  3761.                     P3    : BYTE;
  3762.                     S4    : STR80;
  3763.                     P4    : BYTE;
  3764.                     S5    : STR80;
  3765.                     P5    : BYTE;
  3766.                     S6    : STR80;
  3767.                     P6    : BYTE;
  3768.                     S7    : STR80;
  3769.                     P7    : BYTE;
  3770.                     S8    : STR80;
  3771.                     P8    : BYTE;
  3772.                     S9    : STR80;
  3773.                     P9    : BYTE;
  3774.                     S10   : STR80;
  3775.                     P10   : BYTE) : INTEGER;
  3776.  
  3777. VAR
  3778.   SC       : BUFFER;
  3779.   I        : INTEGER;
  3780.   TOP      : INTEGER;
  3781.   BOT      : INTEGER;
  3782.   LEFTS    : INTEGER;
  3783.   RIGHTS   : INTEGER;
  3784.   SEL      : INTEGER;
  3785.   LONGEST  : INTEGER;
  3786.   NUM_INP  : INTEGER;
  3787.   BAR1     : INTEGER;
  3788.   BAR2     : INTEGER;
  3789.   SAVE_CUR : CURTYPE;
  3790. BEGIN
  3791.   SAVE_CUR := CUR;
  3792.   SET_CURSOR(NONE);
  3793.   SAVE_SCREEN(SC);
  3794.   LONGEST := 0;
  3795.   NUM_INP := 0;
  3796.   IF LENGTH(S1)  > LONGEST THEN LONGEST := LENGTH(S1);
  3797.   IF LENGTH(S2)  > LONGEST THEN LONGEST := LENGTH(S2);
  3798.   IF LENGTH(S3)  > LONGEST THEN LONGEST := LENGTH(S3);
  3799.   IF LENGTH(S4)  > LONGEST THEN LONGEST := LENGTH(S4);
  3800.   IF LENGTH(S5)  > LONGEST THEN LONGEST := LENGTH(S5);
  3801.   IF LENGTH(S6)  > LONGEST THEN LONGEST := LENGTH(S6);
  3802.   IF LENGTH(S7)  > LONGEST THEN LONGEST := LENGTH(S7);
  3803.   IF LENGTH(S8)  > LONGEST THEN LONGEST := LENGTH(S8);
  3804.   IF LENGTH(S9)  > LONGEST THEN LONGEST := LENGTH(S9);
  3805.   IF LENGTH(S10) > LONGEST THEN LONGEST := LENGTH(S10);
  3806.   BAR1 := 40 - (LONGEST DIV 2) - 1;
  3807.   BAR2 := 40 + (LONGEST DIV 2) + 1;
  3808.   IF LONGEST > 0 THEN
  3809.     LONGEST := LONGEST + 2;
  3810.   IF LENGTH(TITLE) > 0 THEN
  3811.     BEGIN
  3812.       TITLE := CHR(16)+' '+TITLE+' '+CHR(17);
  3813.       IF LONGEST < LENGTH(TITLE) + 4 THEN
  3814.         LONGEST := LENGTH(TITLE) + 4;
  3815.     END;
  3816.   IF S1  <> '' THEN
  3817.     BEGIN
  3818.       INC(NUM_INP);              
  3819.       IF S2  <> '' THEN
  3820.         BEGIN
  3821.           INC(NUM_INP);          
  3822.           IF S3  <> '' THEN
  3823.             BEGIN
  3824.               INC(NUM_INP);      
  3825.               IF S4  <> '' THEN
  3826.                 BEGIN
  3827.                   INC(NUM_INP);  
  3828.                   IF S5  <> '' THEN
  3829.                     BEGIN
  3830.                       INC(NUM_INP);
  3831.                       IF S6  <> '' THEN
  3832.                         BEGIN
  3833.                           INC(NUM_INP);
  3834.                           IF S7  <> '' THEN
  3835.                             BEGIN
  3836.                               INC(NUM_INP);
  3837.                               IF S8  <> '' THEN
  3838.                                 BEGIN
  3839.                                   INC(NUM_INP);
  3840.                                   IF S9  <> '' THEN
  3841.                                     BEGIN
  3842.                                       INC(NUM_INP);
  3843.                                       IF S10 <> '' THEN
  3844.                                         INC(NUM_INP);
  3845.                                     END;
  3846.                                 END;
  3847.                             END;
  3848.                         END;
  3849.                     END;
  3850.                 END;
  3851.             END;
  3852.         END;
  3853.     END;
  3854.   IF LONGEST < 17 THEN
  3855.     LONGEST := 17;
  3856.   LEFTS  := 39-(LONGEST DIV 2);
  3857.   TOP    := 11-(NUM_INP DIV 2);
  3858.   RIGHTS := LEFTS + LONGEST + 1;
  3859.   BOT    := TOP + NUM_INP + 4;
  3860.   IF BAR2 >= RIGHTS - 1 THEN
  3861.     BAR2 := RIGHTS - 1;
  3862.   IF LEFTS + 1 >= BAR1 THEN
  3863.     BAR1 := LEFTS + 1;
  3864.   POP_WINDOW(LEFTS,
  3865.              TOP,
  3866.              RIGHTS,
  3867.              BOT, 2, ATTR1);
  3868.   IF LENGTH(TITLE) > 0 THEN
  3869.     CENTER(TOP,ATTR1,TITLE);
  3870.   CENTER(BOT-1,ATTR1,CHR(24)+' '+CHR(25)+' '+ENTER_KEY+'-Select');
  3871.   IF S1 <> '' THEN
  3872.     BEGIN
  3873.       FW(40 - (LENGTH(S1) DIV 2),TOP+2,ATTR1,S1);
  3874.       IF S2 <> '' THEN
  3875.         BEGIN
  3876.           FW(40 - (LENGTH(S2) DIV 2),TOP+3,ATTR1,S2);
  3877.           IF S3 <> '' THEN
  3878.             BEGIN
  3879.               FW(40 - (LENGTH(S3) DIV 2),TOP+4,ATTR1,S3);
  3880.               IF S4 <> '' THEN
  3881.                 BEGIN
  3882.                   FW(40 - (LENGTH(S4) DIV 2),TOP+5,ATTR1,S4);
  3883.                   IF S5 <> '' THEN
  3884.                     BEGIN
  3885.                       FW(40 - (LENGTH(S5) DIV 2),TOP+6,ATTR1,S5);
  3886.                       IF S6 <> '' THEN
  3887.                         BEGIN
  3888.                           FW(40 - (LENGTH(S6) DIV 2),TOP+7,ATTR1,S6);
  3889.                           IF S7 <> '' THEN
  3890.                             BEGIN
  3891.                               FW(40 - (LENGTH(S7) DIV 2),TOP+8,ATTR1,S7);
  3892.                               IF S8 <> '' THEN
  3893.                                 BEGIN
  3894.                                   FW(40 - (LENGTH(S8) DIV 2),TOP+9,ATTR1,S8);
  3895.                                   IF S9 <> '' THEN
  3896.                                     BEGIN
  3897.                                       FW(40 - (LENGTH(S9) DIV 2),TOP+10,ATTR1,S9);
  3898.                                       IF S10 <> '' THEN
  3899.                                         FW(40 - (LENGTH(S10) DIV 2),TOP+11,ATTR1,S10);
  3900.                                     END;
  3901.                                 END;
  3902.                             END;
  3903.                         END;
  3904.                     END;
  3905.                 END;
  3906.             END;
  3907.         END;
  3908.     END;
  3909.   IF NOT ODD(LONGEST) THEN
  3910.     INC(LONGEST);
  3911.   IF LENGTH(S1) > 0 THEN
  3912.     BEGIN
  3913.       SEL := 1;
  3914.       REPEAT                                      
  3915.         IF (P1 <> 0) AND (LENGTH(S1) > 0) THEN
  3916.           BEGIN
  3917.             SET_ATTR([40 - (LENGTH(S1) DIV 2)+P1-1],TOP+2,ATTR3);
  3918.             IF (P2 <> 0) AND (LENGTH(S2) > 0) THEN
  3919.               BEGIN
  3920.                 SET_ATTR([40 - (LENGTH(S2) DIV 2)+P2-1],TOP+3,ATTR3);
  3921.                 IF (P3 <> 0) AND (LENGTH(S3) > 0) THEN
  3922.                   BEGIN
  3923.                     SET_ATTR([40 - (LENGTH(S3) DIV 2)+P3-1],TOP+4,ATTR3);
  3924.                     IF (P4 <> 0) AND (LENGTH(S4) > 0) THEN
  3925.                       BEGIN
  3926.                         SET_ATTR([40 - (LENGTH(S4) DIV 2)+P4-1],TOP+5,ATTR3);
  3927.                         IF (P5 <> 0) AND (LENGTH(S5) > 0) THEN
  3928.                           BEGIN
  3929.                             SET_ATTR([40 - (LENGTH(S5) DIV 2)+P5-1],TOP+6,ATTR3);
  3930.                             IF (P6 <> 0) AND (LENGTH(S6) > 0) THEN
  3931.                               BEGIN
  3932.                                 SET_ATTR([40 - (LENGTH(S6) DIV 2)+P6-1],TOP+7,ATTR3);
  3933.                                 IF (P7 <> 0) AND (LENGTH(S7) > 0) THEN
  3934.                                   BEGIN
  3935.                                     SET_ATTR([40 - (LENGTH(S7) DIV 2)+P7-1],TOP+8,ATTR3);
  3936.                                     IF (P8 <> 0) AND (LENGTH(S8) > 0) THEN
  3937.                                       BEGIN
  3938.                                         SET_ATTR([40 - (LENGTH(S8) DIV 2)+P8-1],TOP+9,ATTR3);
  3939.                                         IF (P9 <> 0) AND (LENGTH(S9) > 0) THEN
  3940.                                           BEGIN
  3941.                                             SET_ATTR([40 - (LENGTH(S9) DIV 2)+P9-1],TOP+10,ATTR3);
  3942.                                             IF (P10 <> 0) AND (LENGTH(S10) > 0) THEN
  3943.                                               SET_ATTR([40 - (LENGTH(S10) DIV 2)+P10-1],TOP+11,ATTR3);END;
  3944.                                       END;
  3945.                                   END;
  3946.                               END;
  3947.                           END;
  3948.                       END;
  3949.                   END;
  3950.               END;
  3951.           END;                                        
  3952.         SET_ATTR([BAR1..BAR2],SEL+TOP+1,ATTR2);
  3953.         READCH(CH,FALSE);
  3954.         SET_ATTR([BAR1..BAR2],SEL+TOP+1,ATTR1);
  3955.         CASE CH OF
  3956.              UP : DEC(SEL);
  3957.            DOWN : INC(SEL);
  3958.            ELSE   BEGIN
  3959.                     IF UPCASE(CH) = UPCASE(S1[P1]) THEN
  3960.                       BEGIN
  3961.                         SEL := 1;
  3962.                         CH := ENTER;
  3963.                       END
  3964.                     ELSE
  3965.                       IF UPCASE(CH) = UPCASE(S2[P2]) THEN
  3966.                         BEGIN
  3967.                           SEL := 2;
  3968.                           CH := ENTER;
  3969.                         END
  3970.                     ELSE
  3971.                       IF UPCASE(CH) = UPCASE(S3[P3]) THEN
  3972.                         BEGIN
  3973.                           SEL := 3;
  3974.                           CH := ENTER;
  3975.                         END
  3976.                     ELSE
  3977.                       IF UPCASE(CH) = UPCASE(S4[P4]) THEN
  3978.                         BEGIN
  3979.                           SEL := 4;
  3980.                           CH := ENTER;
  3981.                         END
  3982.                     ELSE
  3983.                       IF UPCASE(CH) = UPCASE(S5[P5]) THEN
  3984.                         BEGIN
  3985.                           SEL := 5;
  3986.                           CH := ENTER;
  3987.                         END
  3988.                     ELSE
  3989.                       IF UPCASE(CH) = UPCASE(S6[P6]) THEN
  3990.                         BEGIN
  3991.                           SEL := 6;
  3992.                           CH := ENTER;
  3993.                         END
  3994.                     ELSE
  3995.                       IF UPCASE(CH) = UPCASE(S7[P7]) THEN
  3996.                         BEGIN
  3997.                           SEL := 7;
  3998.                           CH := ENTER;
  3999.                         END
  4000.                     ELSE
  4001.                       IF UPCASE(CH) = UPCASE(S8[P8]) THEN
  4002.                         BEGIN
  4003.                           SEL := 8;
  4004.                           CH := ENTER;
  4005.                         END
  4006.                     ELSE
  4007.                       IF UPCASE(CH) = UPCASE(S9[P9]) THEN
  4008.                         BEGIN
  4009.                           SEL := 9;
  4010.                           CH := ENTER;
  4011.                         END
  4012.                     ELSE
  4013.                       IF UPCASE(CH) = UPCASE(S10[P10]) THEN
  4014.                         BEGIN
  4015.                           SEL := 10;
  4016.                           CH := ENTER;
  4017.                         END
  4018.                   END;
  4019.         END;
  4020.         IF SEL > NUM_INP THEN SEL := 1;
  4021.         IF SEL < 1 THEN SEL := NUM_INP;
  4022.       UNTIL CH IN [ESCAPE,ENTER];
  4023.       IF CH = ENTER THEN
  4024.         GET_CHOICE := SEL
  4025.       ELSE
  4026.         GET_CHOICE := 0;
  4027.     END
  4028.   ELSE
  4029.     GET_CHOICE := 0;
  4030.   SET_CURSOR(SAVE_CUR);
  4031.   REBUILD_SCREEN(SC);
  4032. END;
  4033.  
  4034. PROCEDURE DUMP_RECORD(VAR REC;
  4035.                           NUM_BYTES   : INTEGER;
  4036.                           IDNAME      : STR80;
  4037.                           DESTINATION : STR80);
  4038.  
  4039. TYPE
  4040.   HEXBYTE = STRING [2];
  4041. VAR
  4042.   I           : LONGINT;
  4043.   J,
  4044.   TEMP        : INTEGER;
  4045.   HX          : ARRAY [0..255] of HEXBYTE;
  4046.   BUFFER2     : ARRAY [1..32767] OF BYTE ABSOLUTE REC;
  4047.   DEST        : TEXT;
  4048.   DUMPSCREEN  : BUFFER;
  4049.   DATEE       : STRING[30];
  4050.  
  4051.        PROCEDURE PRINT_BUFFER;
  4052.        VAR
  4053.          K : LONGINT;
  4054.        BEGIN
  4055.          I:=1;
  4056.          REPEAT
  4057.            J:=2;
  4058.            REPEAT
  4059.              WRITE(DEST,' ');
  4060.              FOR K:=I TO I+15 DO
  4061.                IF K <= NUM_BYTES THEN
  4062.                  BEGIN
  4063.                    WRITE(DEST,HX[BUFFER2[K]]);
  4064.                    WRITE(DEST,' ');
  4065.                  END
  4066.                ELSE
  4067.                  WRITE(DEST,'   ');
  4068.              WRITE(DEST,'   ');
  4069.              FOR K:=I TO I+15 DO
  4070.                IF K <= NUM_BYTES THEN
  4071.                  IF ORD(BUFFER2[K]) > 32 THEN
  4072.                    WRITE(DEST,CHR(BUFFER2[K]))
  4073.                  ELSE
  4074.                    WRITE(DEST,'.');
  4075.              I:=I+16;
  4076.              J:=J+1;
  4077.              WRITELN(DEST);
  4078.            UNTIL (J=18) OR (I >= NUM_BYTES) OR (I >= 32767);
  4079.            IF DESTINATION = 'CON' THEN
  4080.              BEGIN
  4081.                WRITELN;
  4082.                WRITE('Press <any key> to continue, <ESC> to Exit...');
  4083.                READCH(CH,FALSE);
  4084.                IF CH = ESCAPE THEN
  4085.                  BEGIN
  4086.                    CH := 'X';
  4087.                    EXIT;
  4088.                  END;
  4089.                CH := 'X';
  4090.                CLRSCR;
  4091.                WRITELN(DEST);
  4092.                DATEE := DATE_TIME_KEY;
  4093.                WRITELN(DEST,'*** ',COPY(DATEE,5,2),
  4094.                                    COPY(DATEE,7,2),
  4095.                                    COPY(DATEE,1,4),
  4096.                                    COPY(DATEE,9,2),':',
  4097.                                    COPY(DATEE,11,2),':',
  4098.                                    COPY(DATEE,13,2),':',
  4099.                                    COPY(DATEE,15,2),'         Gemini Systems     DumpRecord');
  4100.                WRITELN(DEST);
  4101.                WRITELN(DEST,'    Variable : ',IDNAME);
  4102.                WRITELN(DEST);
  4103.              END;
  4104.          UNTIL (I >= NUM_BYTES) OR (I >= 32767);
  4105.        END;
  4106.  
  4107. BEGIN
  4108.   SAVE_SCREEN(DUMPSCREEN);
  4109.   IF DESTINATION = '' THEN
  4110.     BEGIN
  4111.       POP_WINDOW(30,8,62,12,2,$4F);
  4112.       FW(32,10,$4E,'F)ile, P)rinter, S)creen ? ');
  4113.       REPEAT
  4114.         GOTOXY(59,10);
  4115.         READCH(CH,TRUE);
  4116.         CH := UPCASE(CH);
  4117.       UNTIL CH IN ['F','P','S',ESCAPE];
  4118.       IF CH = ESCAPE THEN
  4119.         BEGIN
  4120.           REBUILD_SCREEN(DUMPSCREEN);
  4121.           CH := 'X';
  4122.           EXIT;
  4123.         END;
  4124.       CASE CH OF
  4125.          'S' : DESTINATION := 'CON';
  4126.          'P' : DESTINATION := 'PRN';
  4127.          'F' : READSTR(32,11,12,$4F,'Enter Filename..',$70,
  4128.                           DESTINATION,[' '..'~'],
  4129.                           [1..12],
  4130.                           [CLEAR,ENTER],69,2,'N');
  4131.       END;
  4132.       IF CH = ESCAPE THEN
  4133.         BEGIN
  4134.           REBUILD_SCREEN(DUMPSCREEN);
  4135.           HALT;
  4136.         END;
  4137.     END;
  4138.   DESTINATION := UPPERCASE(STRIP(DESTINATION,TRUE));
  4139.   ASSIGN(DEST,DESTINATION);
  4140.   IF (DESTINATION <> 'PRN') AND (DESTINATION <> 'CON') THEN
  4141.     BEGIN
  4142.       {$I-}
  4143.         APPEND(DEST);
  4144.       {$I+}
  4145.       IF IORESULT <> 0 THEN
  4146.         {$I-}
  4147.           REWRITE(DEST);
  4148.         {$I+}
  4149.     END
  4150.   ELSE
  4151.     {$I-}
  4152.       REWRITE(DEST);
  4153.     {$I-}
  4154.   IF IORESULT <> 0 THEN
  4155.     BEGIN
  4156.       CLRSCR;
  4157.       WRITELN('*** ERROR ***   Cannot open "',DESTINATION,'"');
  4158.       WRITELN;
  4159.       WRITELN('Press <any key> ');
  4160.       WHILE KEYPRESSED DO
  4161.         READCH(CH,FALSE);
  4162.       READCH(CH,FALSE);
  4163.       CH := 'X';
  4164.       EXIT;
  4165.     END;
  4166.   for I:=0 to 255 do
  4167.     begin
  4168.       HX[I]:='00';
  4169.       temp:=I mod 16;
  4170.       if temp<=9 then
  4171.         HX[I][2]:=chr(temp+48)
  4172.       else
  4173.         HX[I][2]:=chr(temp+55);
  4174.       temp:=I div 16;
  4175.       if temp<=9 then
  4176.         HX[I][1]:=chr(temp+48)
  4177.       else
  4178.         HX[I][1]:=chr(temp+55);
  4179.     end;        
  4180.   IF DESTINATION = 'CON' THEN
  4181.     CLRSCR;
  4182.   WRITELN(DEST);
  4183.   DATEE := DATE_TIME_KEY;
  4184.   WRITELN(DEST,'*** ',COPY(DATEE,5,2),'-',
  4185.                       COPY(DATEE,7,2),'-',
  4186.                       COPY(DATEE,1,4),' ',
  4187.                       COPY(DATEE,9,2),':',
  4188.                       COPY(DATEE,11,2),':',
  4189.                       COPY(DATEE,13,2),':',
  4190.                       COPY(DATEE,15,2),'         Gemini Systems     DumpRecord');
  4191.   WRITELN(DEST);
  4192.   WRITELN(DEST,'    Variable : ',IDNAME);
  4193.   WRITELN(DEST);
  4194.   PRINT_BUFFER;
  4195.   WRITELN(DEST);
  4196.   WRITELN(DEST);
  4197.   CLOSE(DEST);
  4198.   REBUILD_SCREEN(DUMPSCREEN);
  4199. END;
  4200.  
  4201. FUNCTION GSI_DATE(INDATE : STR8; MASK : STR20) : STR80;
  4202.                 { INDATE must in format mm/dd/yy
  4203.  
  4204.                   MASK:
  4205.                          DD  = Day in format '01'
  4206.                          dd  = Day in format ' 1'
  4207.                          D   = Day in format '1'
  4208.                          MM  = Month in format '02'
  4209.                          mm  = Month in format ' 2'
  4210.                          M   = Month in format '2'
  4211.                          WW  = Month in word format
  4212.                          YY  = Year in format  '1993'
  4213.                          yy  = Year in format  '93'
  4214.  
  4215.                          All other characters in MASK
  4216.                          remain unchanged.
  4217.                                                          }
  4218. VAR
  4219.   MonthIn  : STRING[2];
  4220.   DayIn    : STRING[2];
  4221.   YearIn   : STRING[2];
  4222.   MonthOut : STRING[2];
  4223.   DayOut   : STRING[2];
  4224.   YearOut  : STRING[2];
  4225. BEGIN
  4226.   MonthIn := COPY(INDATE,1,2);
  4227.   DayIn   := COPY(INDATE,4,2);
  4228.   YearIn  := COPY(INDATE,7,2);
  4229.   WHILE POS('DD',MASK) > 0 DO
  4230.     BEGIN
  4231.       IF DayIn[1] = ' ' THEN
  4232.         DayIn[1] := '0';
  4233.       INSERT(DayIn,MASK,POS('DD',MASK));
  4234.       DELETE(MASK,POS('DD',MASK),2);
  4235.     END;
  4236.   WHILE POS('dd',MASK) > 0 DO
  4237.     BEGIN
  4238.       IF DayIn[1] = '0' THEN
  4239.         DayIn[1] := ' ';
  4240.       INSERT(DayIn,MASK,POS('dd',MASK));
  4241.       DELETE(MASK,POS('dd',MASK),2);
  4242.     END;
  4243.  
  4244.   WHILE POS('D',MASK) > 0 DO
  4245.     BEGIN
  4246.       IF DayIn[1] = '0' THEN
  4247.         DayIn[1] := ' ';
  4248.       IF DayIn[1] <> ' ' THEN
  4249.         INSERT(DayIn,MASK,POS('D',MASK))
  4250.       ELSE
  4251.         INSERT(DayIn[2],MASK,POS('D',MASK));
  4252.       DELETE(MASK,POS('D',MASK),1);
  4253.     END;
  4254.  
  4255.  
  4256.   WHILE POS('MM',MASK) > 0 DO
  4257.     BEGIN
  4258.       IF MonthIn[1] = ' ' THEN
  4259.         MonthIn[1] := '0';
  4260.       INSERT(MonthIn,MASK,POS('MM',MASK));
  4261.       DELETE(MASK,POS('MM',MASK),2);
  4262.     END;
  4263.   WHILE POS('mm',MASK) > 0 DO
  4264.     BEGIN
  4265.       IF MonthIn[1] = '0' THEN
  4266.         MonthIn[1] := ' ';
  4267.       INSERT(MonthIn,MASK,POS('mm',MASK));
  4268.       DELETE(MASK,POS('mm',MASK),2);
  4269.     END;
  4270.  
  4271.   WHILE POS('M',MASK) > 0 DO
  4272.     BEGIN
  4273.       IF MonthIn[1] = '0' THEN
  4274.         MonthIn[1] := ' ';
  4275.       IF MonthIn[1] <> ' ' THEN
  4276.         INSERT(MonthIn,MASK,POS('M',MASK))
  4277.       ELSE
  4278.         INSERT(MonthIn[2],MASK,POS('M',MASK));
  4279.       DELETE(MASK,POS('M',MASK),1);
  4280.     END;
  4281.  
  4282.  
  4283.   WHILE POS('WW',MASK) > 0 DO
  4284.     BEGIN
  4285.       CASE _INTEGER(MonthIn) OF
  4286.           1 : INSERT('January',MASK,POS('WW',MASK));
  4287.           2 : INSERT('February',MASK,POS('WW',MASK));
  4288.           3 : INSERT('March',MASK,POS('WW',MASK));
  4289.           4 : INSERT('April',MASK,POS('WW',MASK));
  4290.           5 : INSERT('May',MASK,POS('WW',MASK));
  4291.           6 : INSERT('June',MASK,POS('WW',MASK));
  4292.           7 : INSERT('July',MASK,POS('WW',MASK));
  4293.           8 : INSERT('August',MASK,POS('WW',MASK));
  4294.           9 : INSERT('September',MASK,POS('WW',MASK));
  4295.          10 : INSERT('October',MASK,POS('WW',MASK));
  4296.          11 : INSERT('November',MASK,POS('WW',MASK));
  4297.          12 : INSERT('December',MASK,POS('WW',MASK));
  4298.       END;
  4299.       DELETE(MASK,POS('WW',MASK),2);
  4300.     END;
  4301.   WHILE POS('ww',MASK) > 0 DO
  4302.     BEGIN
  4303.       CASE _INTEGER(MonthIn) OF
  4304.           1 : INSERT('January',MASK,POS('ww',MASK));
  4305.           2 : INSERT('February',MASK,POS('ww',MASK));
  4306.           3 : INSERT('March',MASK,POS('ww',MASK));
  4307.           4 : INSERT('April',MASK,POS('ww',MASK));
  4308.           5 : INSERT('May',MASK,POS('ww',MASK));
  4309.           6 : INSERT('June',MASK,POS('ww',MASK));
  4310.           7 : INSERT('July',MASK,POS('ww',MASK));
  4311.           8 : INSERT('August',MASK,POS('ww',MASK));
  4312.           9 : INSERT('September',MASK,POS('ww',MASK));
  4313.          10 : INSERT('October',MASK,POS('ww',MASK));
  4314.          11 : INSERT('November',MASK,POS('ww',MASK));
  4315.          12 : INSERT('December',MASK,POS('ww',MASK));
  4316.       END;
  4317.       DELETE(MASK,POS('ww',MASK),2);
  4318.     END;
  4319.  
  4320.   WHILE POS('YY',MASK) > 0 DO
  4321.     BEGIN
  4322.       IF YearIn[1] = ' ' THEN
  4323.         YearIn[1] := '0';
  4324.       IF _INTEGER(YearIn) >= 10 THEN
  4325.         INSERT('19'+YearIn,MASK,POS('YY',MASK))
  4326.       ELSE
  4327.         INSERT('20'+YearIn,MASK,POS('YY',MASK));
  4328.       DELETE(MASK,POS('YY',MASK),2);
  4329.     END;
  4330.   WHILE POS('yy',MASK) > 0 DO
  4331.     BEGIN
  4332.       IF YearIn[1] = '0' THEN
  4333.         YearIn[1] := ' ';
  4334.       INSERT(YearIn,MASK,POS('yy',MASK));
  4335.       DELETE(MASK,POS('yy',MASK),2);
  4336.     END;
  4337.   GSI_DATE := MASK;
  4338. END;
  4339.  
  4340. Function ValidDate(INDATE : STR8) : Boolean;
  4341.                 { INDATE must in format mm/dd/yy  }
  4342. VAR
  4343.   Day, Month, Year : Integer;
  4344. CONST
  4345.   Threshold2000 : Integer = 1900;
  4346.   MinYear = 1600;
  4347.   MaxYear = 3999;
  4348.  
  4349.       function IsLeapYear(Year : Integer) : Boolean;
  4350.         {-Return True if Year is a leap year}
  4351.       begin
  4352.         IsLeapYear := (Year mod 4 = 0) and (Year mod 4000 <> 0) and
  4353.           ((Year mod 100 <> 0) or (Year mod 400 = 0));
  4354.       end;
  4355.  
  4356.       function DaysInMonth(Month, Year : Integer) : Integer;
  4357.         {-Return the number of days in the specified month of a given year}
  4358.       begin
  4359.         if Word(Year) < 100 then
  4360.           begin
  4361.             Inc(Year, 1900);
  4362.             if Year < Threshold2000 then
  4363.               Inc(Year, 100);
  4364.           end;
  4365.         case Month of
  4366.           1, 3, 5, 7, 8, 10, 12 : DaysInMonth := 31;
  4367.                     4, 6, 9, 11 : DaysInMonth := 30;
  4368.                               2 : DaysInMonth := 28+Ord(IsLeapYear(Year));
  4369.                            else   DaysInMonth := 0;
  4370.         end;
  4371.       end;
  4372.  
  4373. begin
  4374.   Day   := _INTEGER(COPY(INDATE,4,2));
  4375.   Month := _INTEGER(COPY(INDATE,1,2));
  4376.   Year  := _INTEGER(COPY(INDATE,7,2));
  4377.   if Word(Year) < 100 then
  4378.     begin
  4379.       Inc(Year, 1900);
  4380.       if Year < Threshold2000 then
  4381.         Inc(Year, 100);
  4382.     end;
  4383.   if (Day < 1) or (Year < MinYear) or (Year > MaxYear) then
  4384.     ValidDate := False
  4385.   else
  4386.     case Month of
  4387.             1..12 : ValidDate := Day <= DaysInMonth(Month, Year);
  4388.              else   ValidDate := False;
  4389.     end
  4390. end;
  4391.  
  4392. FUNCTION KEYPRESS : BOOLEAN;
  4393. BEGIN
  4394.   KEYPRESS := KEYPRESSED OR (COMMAND_BUFFER <> '');
  4395. END;
  4396.  
  4397. BEGIN
  4398.   SHOW_ERROR := TRUE;
  4399.   EXITSAVE := EXITPROC;
  4400.   EXITPROC := @EXITHANDLER;
  4401.   TEXTATTR_AT_ENTRY := TEXTATTR;
  4402.   GEMINI_SYSTEMS := 'Hgqiul$Yyzujo|';
  4403.   UN_ENCRYPT(GEMINI_SYSTEMS,69);
  4404.  
  4405.   UT.TIMEX         := 0;
  4406.   UT.TIMEY         := 2;
  4407.   UT.TIME_TYPE     := 'N';
  4408.   UT.DATEX         := 0;
  4409.   UT.DATEY         := 2;
  4410.   UT.DATE_TYPE     := ' ';   { D,W,else }
  4411.   UT.INPUT_ATTR    := $70;
  4412.   UT.DEFAULT_ATTR  := $02;
  4413.   UT.COMPILED_DATE := '%%-%%-%%';
  4414.   UT.COMPILED_TIME := '%%:%%';
  4415.   UT.NOCONV        := FALSE;
  4416.   FILLCHAR(UT.EXITCH,SIZEOF(UT.EXITCH),1);
  4417.   FILLCHAR(UT.EXITCH[32],95,0);
  4418.   UT.EXITCH[191] := FALSE;
  4419.   UT.EXITCH[192] := FALSE;
  4420.   UT.EXITCH[8] := FALSE;
  4421.   UT.EXITCH[196] := FALSE;
  4422.   UT.EXITCH[197] := FALSE;
  4423.   UT.EXITCH[198] := FALSE;
  4424.   UT.EXITCH[199] := FALSE;
  4425.   SET_CURSOR(UNDERLINE);
  4426.   BLINK_ON;
  4427.   CGA_PRESENT := CGA_INSTALLED;
  4428.   EGA_PRESENT := EGA_INSTALLED;
  4429.   VGA_PRESENT := VGA_INSTALLED;
  4430.   CURRENT_BORDER   := 0;
  4431.   GET_DOS_VER;
  4432.   WRITE_TIME(0,1,UT.TIME_TYPE);
  4433.   WRITE_DATE(0,1,UT.DATE_TYPE);
  4434.   DISPLAY := #255;
  4435.   NOCONV  := #254;
  4436.   CLEAR   := #253;
  4437.   X_IN    := 1;
  4438.   X_OUT   := 1;
  4439.   MASTERENV;
  4440.   IF (FILE_EXIST('UTILITY.GO')) THEN
  4441.     FILL_BUFFER;
  4442.   START_TIMER(TIM);
  4443. END.
  4444.